PP-Stichprobenvergleiche (d = 0.92)

1 Vergleich von Klassifikationsmethoden in simulierten Fragebogen-Daten

Vergleich von Methoden zur Veränderungsklassifikation in simulierten Fragebogen-Daten für verschiedene Messzeitpunkt-Intervalle:

“PP_5.5” besteht aus je 5 Messzeitpunkten im Pre- und im Post-Intervall. Dies sind die ursprünglich simulierten Fragebogen-Daten von N = 8226 Personen (ursprünglich N = 100.000).

“PP_30.30” besteht aus je 30 Messzeitpunkten im Pre- und im Post-Intervall. Diese wurden aus den ursprünglichen Simulationsdaten erweitert und umfassen dieselben N = 8226 Personen.

“PP_1.1” besteht jeweils aus dem 1. Messzeitpunkt im Pre- und im Post-Intervall für jede einzelne Person (N = 8226).

# Ausschluss von Personen ohne Varianz in min. einem MZP-Intervall

PP_5.5 = PP_5.5 %>% 
  filter(ind.pretestSD != 0 & ind.posttestSD != 0)

PP_30.30 = PP_30.30 %>% 
  filter(ind.pretestSD != 0 & ind.posttestSD != 0)


PP_5.5 = PP_5.5 %>% 
  filter(ID_orig %in% PP_30.30$ID1_PRE)

PP_30.30 = PP_30.30 %>% 
  filter(ID1_PRE %in% PP_5.5$ID_orig)

PP_1.1 = PP_1.1 %>% 
  filter(ID_orig %in% PP_5.5$ID_orig & ID_orig %in% PP_30.30$ID1_PRE)


PP_5.5 = PP_5.5 %>% 
  add_column(., .before = "ID_orig", ID = 1:nrow(.))

PP_30.30 = PP_30.30 %>% 
  add_column(., .before = "ID1_PRE", ID = 1:nrow(.))

PP_1.1 = PP_1.1 %>% 
  add_column(., .before = "ID_orig", ID = 1:nrow(.))

---

1.1 Überblick über die simulierten Daten

Beispiel-Verläufe in den 3 untersuchten Datensets

1.1.1 Original-Simulationsdaten (je 5 MZP)

PP_5.5 %>%
  within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
            ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>% 
  head() %>% 
  kable() %>% 
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>% 
  scroll_box(width = "100%")

ID	ID_orig	PRE1_1	PRE1_2	PRE1_3	PRE1_4	PRE1_5	POST1_1	POST1_2	POST1_3	POST1_4	POST1_5	PRE_Mean	POST_Mean	MeanDiff	ind.pretestSD	ind.posttestSD
1	1	8	7	11	8	7	1	2	1	4	7	8.2	3.0	5.2	1.64	2.55
2	2	9	10	11	11	11	13	13	8	12	6	10.4	10.4	0.0	0.89	3.21
3	3	8	8	10	11	8	1	2	3	2	2	9.0	2.0	7.0	1.41	0.71
4	4	10	7	8	5	6	6	5	4	3	1	7.2	3.8	3.4	1.92	1.92
5	5	9	6	4	7	9	6	6	7	4	9	7.0	6.4	0.6	2.12	1.82
6	6	12	13	11	10	19	11	10	7	7	6	13.0	8.2	4.8	3.54	2.17

Pre-Post-Verläufe für 9 zufällig gezogene Personen

rand = sample(PP_5.5$ID, 9)

x = tibble(ID = c(rep(rand[1],times=11),
                  rep(rand[2],times=11),
                  rep(rand[3],times=11),
                  rep(rand[4],times=11),
                  rep(rand[5],times=11),
                  rep(rand[6],times=11),
                  rep(rand[7],times=11),
                  rep(rand[8],times=11),
                  rep(rand[9],times=11)),
           MZP = rep(seq(as.Date("2020-01-01"), length.out=11, by="1 day"), times=9),
           Score = c(as.numeric(PP_5.5[rand[1],pre_5mzp]), NA, as.numeric(PP_5.5[rand[1],post_5mzp]),
                     as.numeric(PP_5.5[rand[2],pre_5mzp]), NA, as.numeric(PP_5.5[rand[2],post_5mzp]),
                     as.numeric(PP_5.5[rand[3],pre_5mzp]), NA, as.numeric(PP_5.5[rand[3],post_5mzp]),
                     as.numeric(PP_5.5[rand[4],pre_5mzp]), NA, as.numeric(PP_5.5[rand[4],post_5mzp]),
                     as.numeric(PP_5.5[rand[5],pre_5mzp]), NA, as.numeric(PP_5.5[rand[5],post_5mzp]),
                     as.numeric(PP_5.5[rand[6],pre_5mzp]), NA, as.numeric(PP_5.5[rand[6],post_5mzp]),
                     as.numeric(PP_5.5[rand[7],pre_5mzp]), NA, as.numeric(PP_5.5[rand[7],post_5mzp]),
                     as.numeric(PP_5.5[rand[8],pre_5mzp]), NA, as.numeric(PP_5.5[rand[8],post_5mzp]),
                     as.numeric(PP_5.5[rand[9],pre_5mzp]), NA, as.numeric(PP_5.5[rand[9],post_5mzp])))

x %>%
  group_by(ID) %>% 
  plot_time_series(MZP, Score,
    #.color_var = ID,           # for multiple lines in one plot
    #.color_lab = "ID",
    .facet_ncol = 3,
    .facet_scales = "fixed",
    .interactive = TRUE,
    .facet_collapse = FALSE,
    .smooth = TRUE,
    .smooth_degree = 2,
    .smooth_alpha = 0.5,
    .smooth_size = 0.2
  )

# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R

# PP_5.5
# converting my dataframes to use in the same ggplot structure:
PP_5.5_ts = PP_5.5 %>% 
  select(ID, PRE_Mean, POST_Mean) %>% 
  pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>% 
  mutate(ID = as.factor(ID),
         Interval = rep(c(1,2), times = nrow(PP_5.5)))

save(PP_5.5_ts, file = "Time Series Dataframes/k20_PP_5.5_ts.RData")

###

load("Time Series Dataframes/k20_PP_5.5_ts.RData")

# Repeated measures with box− and violin plots
PP_5.5_ts$jit = jitter(PP_5.5_ts$Interval, amount = .09)

Pre_Post_Box_Violin = ggplot(data = PP_5.5_ts, aes(y = Mean)) +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .5) +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .5) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "dodgerblue", alpha = .5) +
  geom_half_boxplot(
    data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "darkorange", alpha = .5) +
  geom_half_violin(
    data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
    side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
  geom_half_violin(
    data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("Paper-Pencil Data (5+5 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_PP_5.5_Pre_Post_Box_Violin.RData")


# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = PP_5.5_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = PP_5.5_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = PP_5.5_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = PP_5.5_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = PP_5.5_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = PP_5.5_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(PP_5.5))
score_se_2 = score_sd_2/sqrt(nrow(PP_5.5))
score_ci_1 = PP_5.5_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = PP_5.5_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(PP_5.5), nrow(PP_5.5))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c(as.numeric(score_ci_1[1] - score_ci_1[3]), as.numeric(score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)

# PP_5.5_ts$jit = jitter(PP_5.5_ts$Interval, amount = .09)     #already created above
x_tick_means = c(.87, 2.13)

Pre_Post_Box_Violin_Mean_CI = ggplot(data = PP_5.5_ts, aes(y = Mean)) +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .6) +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .6) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "dodgerblue") +
  geom_half_boxplot(
    data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "darkorange") +
  geom_half_violin(
    data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
    side = "l", fill = "dodgerblue") +
  geom_half_violin(
    data = PP_5.5_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange") +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
             position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
  geom_errorbar(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
                                                 ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
                position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
             position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
  geom_errorbar(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
                                                 ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]), 
                position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
  geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("Paper-Pencil Data (5+5 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_PP_5.5_Pre_Post_Box_Violin_Mean_CI.RData")

#knitr::include_graphics("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin_Mean+CI.jpg")

---

1.1.2 Erweiterte Intervall-Daten (je 30 MZP)

PP_30.30 %>% 
  select(-(ID1_PRE:ID6_POST)) %>% 
  within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
            ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>% 
  head() %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>% 
  scroll_box(width = "100%")

ID	PRE1_1	PRE1_2	PRE1_3	PRE1_4	PRE1_5	PRE1_6	PRE1_7	PRE1_8	PRE1_9	PRE1_10	PRE1_11	PRE1_12	PRE1_13	PRE1_14	PRE1_15	PRE1_16	PRE1_17	PRE1_18	PRE1_19	PRE1_20	PRE1_21	PRE1_22	PRE1_23	PRE1_24	PRE1_25	PRE1_26	PRE1_27	PRE1_28	PRE1_29	PRE1_30	POST1_1	POST1_2	POST1_3	POST1_4	POST1_5	POST1_6	POST1_7	POST1_8	POST1_9	POST1_10	POST1_11	POST1_12	POST1_13	POST1_14	POST1_15	POST1_16	POST1_17	POST1_18	POST1_19	POST1_20	POST1_21	POST1_22	POST1_23	POST1_24	POST1_25	POST1_26	POST1_27	POST1_28	POST1_29	POST1_30	PRE_Mean	POST_Mean	MeanDiff	ind.pretestSD	ind.posttestSD
1	8	7	11	8	7	7	10	10	7	7	9	9	6	7	10	9	7	9	10	6	7	7	10	10	7	11	8	8	7	7	1	2	1	4	7	7	4	1	1	2	7	1	1	2	4	2	1	1	4	7	1	1	2	4	7	1	4	2	1	7	8.2	3.0	5.2	1.49	2.32
2	9	10	11	11	11	11	11	9	10	11	10	12	10	10	10	10	11	11	11	9	10	11	11	11	9	11	10	11	11	9	13	13	8	12	6	6	14	13	10	9	11	10	10	6	15	14	13	9	10	6	6	9	13	14	10	6	10	9	14	13	10.4	10.4	0.0	0.81	2.92
3	8	8	10	11	8	10	10	8	7	10	7	9	9	9	11	11	7	9	9	9	11	7	9	9	9	10	7	10	10	8	1	2	3	2	2	2	1	2	3	2	2	2	2	3	1	1	2	3	2	2	3	2	1	2	2	2	2	2	3	1	9.0	2.0	7.0	1.29	0.64
4	10	7	8	5	6	6	8	10	7	5	9	7	8	4	8	9	7	8	8	4	7	9	8	8	4	10	5	6	8	7	6	5	4	3	1	7	4	3	3	2	4	3	1	5	6	5	6	3	4	1	4	3	1	6	5	6	4	5	3	1	7.2	3.8	3.4	1.75	1.75
5	9	6	4	7	9	7	9	4	6	9	10	7	5	8	5	5	5	8	7	10	6	9	4	7	9	5	5	8	10	7	6	6	7	4	9	6	4	7	9	6	8	5	4	7	8	7	8	8	5	4	4	5	7	8	8	7	8	8	4	5	7.0	6.4	0.6	1.93	1.65
6	12	13	11	10	19	16	7	14	13	15	10	11	13	12	19	18	15	12	11	9	19	13	12	10	11	11	12	10	13	19	11	10	7	7	6	11	10	7	7	6	7	7	12	8	7	11	8	5	9	8	11	6	10	7	7	10	9	5	10	7	13.0	8.2	4.8	3.22	1.97

Pre-Post-Verläufe für 9 zufällig gezogene Personen

rand = sample(PP_30.30$ID, 9)

x = tibble(ID = c(rep(rand[1],times=61),
                     rep(rand[2],times=61),
                     rep(rand[3],times=61),
                     rep(rand[4],times=61),
                     rep(rand[5],times=61),
                     rep(rand[6],times=61),
                     rep(rand[7],times=61),
                     rep(rand[8],times=61),
                     rep(rand[9],times=61)),
              MZP = rep(seq(as.Date("2020-01-01"), length.out=61, by="1 day"), times=9),
              Score = c(as.numeric(PP_30.30[rand[1],pre_30mzp]), NA, as.numeric(PP_30.30[rand[1],post_30mzp]),
                        as.numeric(PP_30.30[rand[2],pre_30mzp]), NA, as.numeric(PP_30.30[rand[2],post_30mzp]),
                        as.numeric(PP_30.30[rand[3],pre_30mzp]), NA, as.numeric(PP_30.30[rand[3],post_30mzp]),
                        as.numeric(PP_30.30[rand[4],pre_30mzp]), NA, as.numeric(PP_30.30[rand[4],post_30mzp]),
                        as.numeric(PP_30.30[rand[5],pre_30mzp]), NA, as.numeric(PP_30.30[rand[5],post_30mzp]),
                        as.numeric(PP_30.30[rand[6],pre_30mzp]), NA, as.numeric(PP_30.30[rand[6],post_30mzp]),
                        as.numeric(PP_30.30[rand[7],pre_30mzp]), NA, as.numeric(PP_30.30[rand[7],post_30mzp]),
                        as.numeric(PP_30.30[rand[8],pre_30mzp]), NA, as.numeric(PP_30.30[rand[8],post_30mzp]),
                        as.numeric(PP_30.30[rand[9],pre_30mzp]), NA, as.numeric(PP_30.30[rand[9],post_30mzp])))

x %>%
  group_by(ID) %>% 
  plot_time_series(MZP, Score,
    #.color_var = ID,           # for multiple lines in one plot
    #.color_lab = "ID",
    .facet_ncol = 3,
    .facet_scales = "fixed",
    .interactive = TRUE,
    .facet_collapse = FALSE,
    .smooth = TRUE,
    .smooth_degree = 2,
    .smooth_alpha = 0.5,
    .smooth_size = 0.2
  )

# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R

# PP_30.30
# converting my dataframes to use in the same ggplot structure:
PP_30.30_ts = PP_30.30 %>% 
  select(ID, PRE_Mean, POST_Mean) %>% 
  pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>% 
  mutate(ID = as.factor(ID),
         Interval = rep(c(1,2), times = nrow(PP_30.30)))

save(PP_30.30_ts, file = "Time Series Dataframes/k20_PP_30.30_ts.RData")

###

load("Time Series Dataframes/k20_PP_30.30_ts.RData")

# Repeated measures with box− and violin plots
PP_30.30_ts$jit = jitter(PP_30.30_ts$Interval, amount = .09)

Pre_Post_Box_Violin = ggplot(data = PP_30.30_ts, aes(y = Mean)) +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .5) +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .5) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "dodgerblue", alpha = .5) +
  geom_half_boxplot(
    data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "darkorange", alpha = .5) +
  geom_half_violin(
    data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
    side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
  geom_half_violin(
    data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("Paper-Pencil Data (30+30 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_PP_30.30_Pre_Post_Box_Violin.RData")


# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = PP_30.30_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = PP_30.30_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = PP_30.30_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = PP_30.30_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = PP_30.30_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = PP_30.30_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(PP_30.30))
score_se_2 = score_sd_2/sqrt(nrow(PP_30.30))
score_ci_1 = PP_30.30_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = PP_30.30_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(PP_30.30), nrow(PP_30.30))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c((score_ci_1[1] - score_ci_1[3]), (score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)

# PP_30.30_ts$jit = jitter(PP_30.30_ts$Interval, amount = .09)     #already created above
x_tick_means = c(.87, 2.13)

Pre_Post_Box_Violin_Mean_CI = ggplot(data = PP_30.30_ts, aes(y = Mean)) +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .6) +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .6) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "dodgerblue") +
  geom_half_boxplot(
    data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "darkorange") +
  geom_half_violin(
    data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
    side = "l", fill = "dodgerblue") +
  geom_half_violin(
    data = PP_30.30_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange") +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
             position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
  geom_errorbar(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
                                                 ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
                position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
             position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
  geom_errorbar(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
                                                 ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]), 
                position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
  geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("Paper-Pencil Data (30+30 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_PP_30.30_Pre_Post_Box_Violin_Mean_CI.RData")

#knitr::include_graphics("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin_Mean+CI.jpg")

---

1.1.3 Stichprobe mit je 1 MZP

kable(head(PP_1.1)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

ID	ID_orig	PRE	POST	Diff
1	1	8	1	7
2	2	9	13	-4
3	3	8	1	7
4	4	10	6	4
5	5	9	6	3
6	6	12	11	1

Pre-Post-Verläufe für 9 zufällig gezogene Personen

rand = sample(PP_1.1$ID, 9)

x = tibble(ID = c(rep(rand[1],times=3),
                     rep(rand[2],times=3),
                     rep(rand[3],times=3),
                     rep(rand[4],times=3),
                     rep(rand[5],times=3),
                     rep(rand[6],times=3),
                     rep(rand[7],times=3),
                     rep(rand[8],times=3),
                     rep(rand[9],times=3)),
              MZP = rep(seq(as.Date("2020-01-01"), length.out=3, by="1 day"), times=9),
              Score = c(as.numeric(PP_1.1[rand[1],"PRE"]), NA, as.numeric(PP_1.1[rand[1],"POST"]),
                        as.numeric(PP_1.1[rand[2],"PRE"]), NA, as.numeric(PP_1.1[rand[2],"POST"]),
                        as.numeric(PP_1.1[rand[3],"PRE"]), NA, as.numeric(PP_1.1[rand[3],"POST"]),
                        as.numeric(PP_1.1[rand[4],"PRE"]), NA, as.numeric(PP_1.1[rand[4],"POST"]),
                        as.numeric(PP_1.1[rand[5],"PRE"]), NA, as.numeric(PP_1.1[rand[5],"POST"]),
                        as.numeric(PP_1.1[rand[6],"PRE"]), NA, as.numeric(PP_1.1[rand[6],"POST"]),
                        as.numeric(PP_1.1[rand[7],"PRE"]), NA, as.numeric(PP_1.1[rand[7],"POST"]),
                        as.numeric(PP_1.1[rand[8],"PRE"]), NA, as.numeric(PP_1.1[rand[8],"POST"]),
                        as.numeric(PP_1.1[rand[9],"PRE"]), NA, as.numeric(PP_1.1[rand[9],"POST"])))

x %>%
  group_by(ID) %>% 
  plot_time_series(MZP, Score,
    #.color_var = ID,           # for multiple lines in one plot
    #.color_lab = "ID",
    .facet_ncol = 3,
    .facet_scales = "fixed",
    .interactive = TRUE,
    .facet_collapse = FALSE,
    .smooth = TRUE,
    .smooth_degree = 2,
    .smooth_alpha = 0.5,
    .smooth_size = 0.2
  )

# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R

# PP_1.1
# converting my dataframes to use in the same ggplot structure:
PP_1.1_ts = PP_1.1 %>% 
  select(ID, PRE, POST) %>% 
  pivot_longer(!ID, names_to = "Timepoint", values_to = "Score") %>% 
  mutate(ID = as.factor(ID),
         Timepoint = rep(c(1,2), times = nrow(PP_1.1)))

save(PP_1.1_ts, file = "Time Series Dataframes/k20_PP_1.1_ts.RData")

###

load("Time Series Dataframes/k20_PP_1.1_ts.RData")

# Repeated measures with box− and violin plots
PP_1.1_ts$jit = jitter(PP_1.1_ts$Timepoint, amount = .09)

Pre_Post_Box_Violin = ggplot(data = PP_1.1_ts, aes(y = Score)) +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .5) +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .5) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = -.25),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "dodgerblue", alpha = .5) +
  geom_half_boxplot(
    data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = Score), position = position_nudge(x = .15),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "darkorange", alpha = .5) +
  geom_half_violin(
    data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = 1.3),
    side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
  geom_half_violin(
    data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = Score), position = position_nudge(x = .3),
    side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Single Assessment") + ylab("PHQ-9 Score") +
  #ggtitle("Paper-Pencil Data (1+1 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_PP_1.1_Pre_Post_Box_Violin.RData")


# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% summarise(mean(Score)) %>% as.numeric()
score_mean_2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% summarise(mean(Score)) %>% as.numeric()
score_median1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% summarise(median(Score)) %>% as.numeric()
score_median2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% summarise(median(Score)) %>% as.numeric()
score_sd_1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% summarise(sd(Score)) %>% as.numeric()
score_sd_2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% summarise(sd(Score)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(PP_1.1))
score_se_2 = score_sd_2/sqrt(nrow(PP_1.1))
score_ci_1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% pull(Score) %>% CI(., ci = 0.95)
score_ci_2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% pull(Score) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(PP_1.1), nrow(PP_1.1))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c((score_ci_1[1] - score_ci_1[3]), (score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)

# PP_1.1_ts$jit = jitter(PP_1.1_ts$Timepoint, amount = .09)     #already created above
x_tick_means = c(.87, 2.13)

Pre_Post_Box_Violin_Mean_CI = ggplot(data = PP_1.1_ts, aes(y = Score)) +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .6) +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .6) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = -.28),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "dodgerblue") +
  geom_half_boxplot(
    data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = Score), position = position_nudge(x = .18),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "darkorange") +
  geom_half_violin(
    data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = -.3),
    side = "l", fill = "dodgerblue") +
  geom_half_violin(
    data = PP_1.1_ts %>% filter(Timepoint == "2"),aes(x = Timepoint, y = Score), position = position_nudge(x = .3),
    side = "r", fill = "darkorange") +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = score_mean[1]),
             position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
  geom_errorbar(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = score_mean[1],
                                                 ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
                position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = score_mean[2]),
             position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
  geom_errorbar(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = score_mean[2],
                                                 ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]), 
                position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
  geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Single Assessment") + ylab("PHQ-9 Score") +
  #ggtitle("Paper-Pencil Data (1+1 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_PP_1.1_Pre_Post_Box_Violin_Mean_CI.RData")

#knitr::include_graphics("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin_Mean+CI.jpg")

---

1.2 Deskriptive Statistiken der Datensets

tibble(Descriptives = c("mean_PRE_Mean","mean_POST_Mean","mean_MeanDiff","mean_PRE_1MZP","mean_POST_1MZP",
                        "mean_Diff_1MZP","mean_ind.pretestSD","mean_ind.posttestSD","sd_PRE_1MZP","sd_POST_1MZP"),
       PP_5.5 = round(c(mean(PP_5.5$PRE_Mean),mean(PP_5.5$POST_Mean),mean(PP_5.5$MeanDiff),NA,NA,NA,
                       mean(PP_5.5$ind.pretestSD),mean(PP_5.5$ind.posttestSD),NA,NA), digits = 3),
       PP_30.30 = round(c(mean(PP_30.30$PRE_Mean),mean(PP_30.30$POST_Mean),mean(PP_30.30$MeanDiff),
                         NA,NA,NA,mean(PP_30.30$ind.pretestSD),mean(PP_30.30$ind.posttestSD),NA,NA), digits = 3),
       PP_1.1 = round(c(NA,NA,NA,mean(PP_1.1$PRE),mean(PP_1.1$POST),mean(PP_1.1$Diff),
                          NA,NA,sd(PP_1.1$PRE),sd(PP_1.1$POST)), digits = 3)) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

Descriptives	PP_5.5	PP_30.30	PP_1.1
mean_PRE_Mean	10.335	10.335	NA
mean_POST_Mean	7.077	7.077	NA
mean_MeanDiff	3.258	3.258	NA
mean_PRE_1MZP	NA	NA	10.321
mean_POST_1MZP	NA	NA	7.036
mean_Diff_1MZP	NA	NA	3.286
mean_ind.pretestSD	2.047	1.862	NA
mean_ind.posttestSD	2.531	2.302	NA
sd_PRE_1MZP	NA	NA	3.196
sd_POST_1MZP	NA	NA	3.941

Boxplots der Pre- und Post-(Mittel-)Werte

# Boxplots zum Vergleich
temp = tibble(Scores = c(PP_5.5$PRE_Mean, PP_30.30$PRE_Mean, PP_1.1$PRE), 
              Datasets = rep(c("PP_5.5", "PP_30.30", "PP_1.1"), each = length(PP_5.5$PRE_Mean)))

ggplot(temp, aes(x = Datasets, y = Scores)) + 
  geom_boxplot() + 
  ylim(0, 27) +
  ggtitle("PHQ-9 PRE(-Mean)") +
  xlab("Dataset") +
  ylab("PHQ-9 Scores")

temp = tibble(Scores = c(PP_5.5$POST_Mean, PP_30.30$POST_Mean, PP_1.1$POST), 
              Datasets = rep(c("PP_5.5", "PP_30.30", "PP_1.1"), each = length(PP_5.5$POST_Mean)))

ggplot(temp, aes(x = Datasets, y = Scores)) + 
  geom_boxplot() + 
  ylim(0, 27) +
  ggtitle("PHQ-9 POST(-Mean)") +
  xlab("Dataset") +
  ylab("PHQ-9 Scores")

Prozentuale Überlappung der Pre-(Mittel-)Werte

# Overlap-Plots zum Vergleich
final.plot(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_30.30_PRE_Mean = PP_30.30$PRE_Mean), 
           overlap(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_30.30_PRE_Mean = PP_30.30$PRE_Mean))$OV)

final.plot(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE), 
           overlap(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE))$OV)

final.plot(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE), 
           overlap(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE))$OV)

Prozentuale Überlappung der Post-(Mittel-)Werte

# Overlap-Plots zum Vergleich
final.plot(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_30MZP_POST_Mean = PP_30.30$POST_Mean), 
           overlap(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_30MZP_POST_Mean = PP_30.30$POST_Mean))$OV)

final.plot(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_1.1_POST = PP_1.1$POST), 
           overlap(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_1.1_POST = PP_1.1$POST))$OV)

final.plot(list(PP_30MZP_POST_Mean = PP_30.30$POST_Mean, PP_1.1_POST = PP_1.1$POST), 
           overlap(list(PP_30MZP_POST_Mean = PP_30.30$POST_Mean, PP_1.1_POST = PP_1.1$POST))$OV)

---

1.3 Reliabilitäten und Inter-Item-Korrelationen

1.3.1 PP_5.5 (je 5 MZP)

# Korrelationsmatrix von PRE- und POST-MZP:
PP_5.5_KorMat = cor(PP_5.5[, c(pre_5mzp, post_5mzp)]) %>% 
  round(., digits = 2)

# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (Fisher-Z-transformiert):
pre_inter_item_rtt = 0L
for (i in 1:4) {
  pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(PP_5.5_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 4)

post_inter_item_rtt = 0L
for (i in 5:9) {
  post_inter_item_rtt = post_inter_item_rtt + FisherZ(PP_5.5_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 4)


for (i in 1:9) {
  PP_5.5_KorMat[i, i+1] = cell_spec(PP_5.5_KorMat[i, i+1], "html", bold = TRUE)
}

rownames(PP_5.5_KorMat) = cell_spec(rownames(PP_5.5_KorMat), "html", bold = TRUE)

PP_5.5_KorMat %>%
  kable(., format = "html", escape = FALSE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, fixed_thead = T)

	PRE1_1	PRE1_2	PRE1_3	PRE1_4	PRE1_5	POST1_1	POST1_2	POST1_3	POST1_4	POST1_5
PRE1_1	1	0.67	0.49	0.37	0.29	0.34	0.22	0.16	0.12	0.09
PRE1_2	0.67	1	0.68	0.5	0.38	0.23	0.15	0.11	0.09	0.07
PRE1_3	0.49	0.68	1	0.68	0.49	0.17	0.11	0.09	0.07	0.05
PRE1_4	0.37	0.5	0.68	1	0.67	0.13	0.08	0.06	0.06	0.04
PRE1_5	0.29	0.38	0.49	0.67	1	0.1	0.06	0.07	0.05	0.03
POST1_1	0.34	0.23	0.17	0.13	0.1	1	0.66	0.48	0.36	0.28
POST1_2	0.22	0.15	0.11	0.08	0.06	0.66	1	0.67	0.49	0.37
POST1_3	0.16	0.11	0.09	0.06	0.07	0.48	0.67	1	0.68	0.48
POST1_4	0.12	0.09	0.07	0.06	0.05	0.36	0.49	0.68	1	0.66
POST1_5	0.09	0.07	0.05	0.04	0.03	0.28	0.37	0.48	0.66	1

# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(PP_5.5[pre_5mzp])
POST_alpha = CronbachAlpha(PP_5.5[post_5mzp])
PP_5.5_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))

Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.179.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.68.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.68.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.843.

---

1.3.2 PP_30.30 (je 30 MZP)

# Korrelationsmatrix von PRE- und POST-MZP:
PP_30.30_KorMat = cor(PP_30.30[, c(pre_30mzp, post_30mzp)]) %>% 
  round(., digits = 2)

# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (Fisher-Z-transformiert):
pre_inter_item_rtt = 0L
for (i in 1:29) {
  pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(PP_30.30_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 29)

post_inter_item_rtt = 0L
for (i in 31:59) {
  post_inter_item_rtt = post_inter_item_rtt + FisherZ(PP_30.30_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 29)


for (i in 1:59) {
  PP_30.30_KorMat[i, i+1] = cell_spec(PP_30.30_KorMat[i, i+1], "html", bold = TRUE)
}

rownames(PP_30.30_KorMat) = cell_spec(rownames(PP_30.30_KorMat), "html", bold = TRUE)

PP_30.30_KorMat %>%
  kable(., format = "html", escape = FALSE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, fixed_thead = T) %>%
  scroll_box(height = "800px")

	PRE1_1	PRE1_2	PRE1_3	PRE1_4	PRE1_5	PRE1_6	PRE1_7	PRE1_8	PRE1_9	PRE1_10	PRE1_11	PRE1_12	PRE1_13	PRE1_14	PRE1_15	PRE1_16	PRE1_17	PRE1_18	PRE1_19	PRE1_20	PRE1_21	PRE1_22	PRE1_23	PRE1_24	PRE1_25	PRE1_26	PRE1_27	PRE1_28	PRE1_29	PRE1_30	POST1_1	POST1_2	POST1_3	POST1_4	POST1_5	POST1_6	POST1_7	POST1_8	POST1_9	POST1_10	POST1_11	POST1_12	POST1_13	POST1_14	POST1_15	POST1_16	POST1_17	POST1_18	POST1_19	POST1_20	POST1_21	POST1_22	POST1_23	POST1_24	POST1_25	POST1_26	POST1_27	POST1_28	POST1_29	POST1_30
PRE1_1	1	0.67	0.49	0.37	0.29	0.51	0.58	0.6	0.59	0.53	0.51	0.59	0.61	0.59	0.51	0.54	0.58	0.6	0.58	0.51	0.53	0.59	0.6	0.58	0.52	0.5	0.59	0.61	0.58	0.53	0.34	0.22	0.16	0.12	0.09	0.16	0.2	0.2	0.2	0.17	0.18	0.19	0.19	0.19	0.18	0.15	0.19	0.21	0.2	0.18	0.17	0.2	0.2	0.19	0.17	0.18	0.2	0.2	0.19	0.16
PRE1_2	0.67	1	0.68	0.5	0.38	0.59	0.67	0.7	0.67	0.59	0.58	0.68	0.7	0.68	0.59	0.61	0.68	0.7	0.66	0.57	0.59	0.68	0.7	0.66	0.59	0.59	0.67	0.7	0.67	0.6	0.23	0.15	0.11	0.09	0.07	0.12	0.14	0.14	0.13	0.11	0.12	0.13	0.13	0.13	0.13	0.11	0.14	0.14	0.14	0.12	0.12	0.14	0.14	0.13	0.12	0.13	0.14	0.13	0.13	0.12
PRE1_3	0.49	0.68	1	0.68	0.49	0.62	0.7	0.72	0.69	0.61	0.61	0.69	0.72	0.71	0.61	0.62	0.71	0.73	0.69	0.59	0.61	0.7	0.74	0.69	0.61	0.6	0.69	0.73	0.7	0.62	0.17	0.11	0.09	0.07	0.05	0.08	0.11	0.11	0.1	0.09	0.08	0.1	0.1	0.11	0.1	0.09	0.11	0.11	0.1	0.09	0.09	0.09	0.11	0.11	0.09	0.09	0.11	0.1	0.11	0.09
PRE1_4	0.37	0.5	0.68	1	0.67	0.6	0.69	0.69	0.66	0.58	0.59	0.67	0.7	0.68	0.58	0.6	0.67	0.7	0.67	0.58	0.59	0.67	0.7	0.67	0.59	0.57	0.68	0.71	0.67	0.6	0.13	0.08	0.06	0.06	0.04	0.06	0.08	0.09	0.08	0.05	0.07	0.08	0.08	0.08	0.06	0.07	0.07	0.08	0.08	0.07	0.07	0.06	0.08	0.08	0.06	0.06	0.08	0.08	0.08	0.06
PRE1_5	0.29	0.38	0.49	0.67	1	0.54	0.6	0.61	0.58	0.52	0.51	0.6	0.62	0.59	0.51	0.53	0.58	0.61	0.6	0.52	0.54	0.59	0.61	0.59	0.51	0.52	0.59	0.62	0.58	0.54	0.1	0.06	0.07	0.05	0.03	0.06	0.08	0.07	0.05	0.05	0.05	0.07	0.07	0.07	0.05	0.07	0.06	0.06	0.06	0.06	0.06	0.05	0.07	0.07	0.06	0.04	0.07	0.07	0.07	0.06
PRE1_6	0.51	0.59	0.62	0.6	0.54	1	0.68	0.5	0.38	0.31	0.51	0.61	0.63	0.59	0.52	0.55	0.58	0.61	0.6	0.52	0.52	0.6	0.63	0.59	0.53	0.52	0.6	0.63	0.58	0.54	0.18	0.12	0.08	0.06	0.04	0.08	0.11	0.11	0.1	0.08	0.09	0.1	0.1	0.1	0.09	0.09	0.1	0.1	0.1	0.09	0.09	0.1	0.11	0.1	0.09	0.08	0.1	0.11	0.11	0.08
PRE1_7	0.58	0.67	0.7	0.69	0.6	0.68	1	0.67	0.5	0.38	0.57	0.69	0.71	0.67	0.59	0.61	0.67	0.69	0.67	0.58	0.59	0.68	0.7	0.68	0.58	0.57	0.67	0.72	0.69	0.59	0.2	0.12	0.09	0.07	0.04	0.09	0.12	0.12	0.1	0.09	0.09	0.11	0.11	0.11	0.11	0.09	0.11	0.11	0.11	0.1	0.1	0.1	0.11	0.11	0.1	0.09	0.12	0.11	0.11	0.09
PRE1_8	0.6	0.7	0.72	0.69	0.61	0.5	0.67	1	0.67	0.5	0.6	0.68	0.74	0.71	0.6	0.63	0.69	0.71	0.69	0.61	0.62	0.7	0.72	0.68	0.61	0.61	0.69	0.74	0.69	0.6	0.2	0.12	0.09	0.07	0.05	0.09	0.12	0.12	0.11	0.09	0.1	0.11	0.11	0.11	0.11	0.09	0.11	0.12	0.11	0.1	0.1	0.1	0.12	0.11	0.1	0.1	0.12	0.11	0.11	0.1
PRE1_9	0.59	0.67	0.69	0.66	0.58	0.38	0.5	0.67	1	0.65	0.6	0.66	0.69	0.68	0.58	0.59	0.67	0.71	0.66	0.56	0.57	0.69	0.69	0.66	0.59	0.58	0.66	0.67	0.68	0.61	0.2	0.14	0.12	0.11	0.08	0.12	0.14	0.14	0.13	0.11	0.12	0.13	0.13	0.14	0.12	0.12	0.13	0.14	0.13	0.12	0.12	0.12	0.14	0.14	0.11	0.11	0.14	0.13	0.14	0.12
PRE1_10	0.53	0.59	0.61	0.58	0.52	0.31	0.38	0.5	0.65	1	0.53	0.6	0.6	0.6	0.51	0.53	0.6	0.61	0.59	0.51	0.56	0.59	0.61	0.58	0.51	0.52	0.61	0.61	0.58	0.53	0.18	0.13	0.1	0.1	0.06	0.1	0.13	0.13	0.12	0.1	0.11	0.12	0.12	0.12	0.1	0.1	0.11	0.12	0.13	0.11	0.11	0.12	0.12	0.12	0.11	0.11	0.12	0.12	0.12	0.1
PRE1_11	0.51	0.58	0.61	0.59	0.51	0.51	0.57	0.6	0.6	0.53	1	0.65	0.48	0.39	0.29	0.52	0.59	0.6	0.58	0.52	0.51	0.58	0.6	0.58	0.54	0.51	0.56	0.59	0.58	0.55	0.18	0.11	0.09	0.07	0.04	0.09	0.1	0.1	0.1	0.09	0.09	0.1	0.1	0.1	0.09	0.09	0.1	0.11	0.1	0.08	0.09	0.1	0.1	0.1	0.09	0.08	0.11	0.1	0.1	0.09
PRE1_12	0.59	0.68	0.69	0.67	0.6	0.61	0.69	0.68	0.66	0.6	0.65	1	0.7	0.51	0.37	0.61	0.66	0.7	0.68	0.59	0.59	0.68	0.7	0.67	0.59	0.58	0.68	0.7	0.68	0.6	0.21	0.13	0.1	0.09	0.06	0.11	0.14	0.13	0.12	0.1	0.11	0.13	0.12	0.12	0.11	0.11	0.12	0.14	0.12	0.11	0.11	0.12	0.13	0.13	0.12	0.11	0.13	0.13	0.12	0.11
PRE1_13	0.61	0.7	0.72	0.7	0.62	0.63	0.71	0.74	0.69	0.6	0.48	0.7	1	0.69	0.48	0.62	0.7	0.74	0.71	0.59	0.64	0.72	0.73	0.69	0.58	0.6	0.69	0.75	0.7	0.62	0.21	0.14	0.1	0.09	0.07	0.11	0.14	0.14	0.12	0.1	0.12	0.13	0.13	0.12	0.11	0.11	0.12	0.13	0.13	0.12	0.11	0.13	0.13	0.13	0.12	0.11	0.13	0.13	0.13	0.11
PRE1_14	0.59	0.68	0.71	0.68	0.59	0.59	0.67	0.71	0.68	0.6	0.39	0.51	0.69	1	0.66	0.61	0.67	0.71	0.69	0.58	0.6	0.69	0.71	0.66	0.59	0.59	0.69	0.71	0.68	0.58	0.2	0.13	0.1	0.08	0.05	0.09	0.13	0.13	0.11	0.09	0.1	0.11	0.12	0.12	0.11	0.1	0.12	0.12	0.12	0.11	0.11	0.11	0.13	0.12	0.1	0.11	0.12	0.11	0.13	0.1
PRE1_15	0.51	0.59	0.61	0.58	0.51	0.52	0.59	0.6	0.58	0.51	0.29	0.37	0.48	0.66	1	0.55	0.6	0.6	0.55	0.51	0.51	0.58	0.6	0.58	0.53	0.51	0.61	0.61	0.56	0.52	0.17	0.11	0.09	0.07	0.05	0.08	0.11	0.11	0.1	0.08	0.08	0.09	0.1	0.11	0.1	0.08	0.1	0.1	0.1	0.1	0.1	0.09	0.11	0.1	0.08	0.09	0.11	0.11	0.1	0.08
PRE1_16	0.54	0.61	0.62	0.6	0.53	0.55	0.61	0.63	0.59	0.53	0.52	0.61	0.62	0.61	0.55	1	0.7	0.51	0.39	0.3	0.56	0.61	0.61	0.59	0.53	0.56	0.6	0.61	0.59	0.53	0.18	0.11	0.08	0.07	0.04	0.09	0.12	0.11	0.1	0.08	0.09	0.1	0.1	0.1	0.1	0.09	0.1	0.1	0.11	0.09	0.1	0.09	0.1	0.1	0.1	0.09	0.11	0.1	0.11	0.08
PRE1_17	0.58	0.68	0.71	0.67	0.58	0.58	0.67	0.69	0.67	0.6	0.59	0.66	0.7	0.67	0.6	0.7	1	0.67	0.49	0.35	0.6	0.68	0.69	0.67	0.58	0.58	0.65	0.7	0.67	0.61	0.19	0.12	0.1	0.09	0.05	0.1	0.12	0.12	0.12	0.1	0.1	0.12	0.11	0.12	0.11	0.09	0.11	0.12	0.12	0.11	0.11	0.12	0.12	0.11	0.1	0.1	0.12	0.12	0.12	0.1
PRE1_18	0.6	0.7	0.73	0.7	0.61	0.61	0.69	0.71	0.71	0.61	0.6	0.7	0.74	0.71	0.6	0.51	0.67	1	0.68	0.47	0.6	0.71	0.74	0.7	0.6	0.58	0.69	0.73	0.71	0.63	0.21	0.15	0.12	0.09	0.07	0.11	0.14	0.14	0.13	0.12	0.13	0.13	0.13	0.13	0.12	0.12	0.13	0.14	0.13	0.12	0.11	0.13	0.14	0.14	0.11	0.11	0.14	0.13	0.14	0.12
PRE1_19	0.58	0.66	0.69	0.67	0.6	0.6	0.67	0.69	0.66	0.59	0.58	0.68	0.71	0.69	0.55	0.39	0.49	0.68	1	0.65	0.6	0.67	0.7	0.65	0.59	0.57	0.68	0.7	0.67	0.6	0.2	0.13	0.1	0.08	0.06	0.09	0.13	0.14	0.12	0.1	0.11	0.12	0.12	0.12	0.1	0.11	0.12	0.13	0.11	0.1	0.11	0.11	0.12	0.12	0.1	0.11	0.12	0.12	0.12	0.1
PRE1_20	0.51	0.57	0.59	0.58	0.52	0.52	0.58	0.61	0.56	0.51	0.52	0.59	0.59	0.58	0.51	0.3	0.35	0.47	0.65	1	0.49	0.58	0.59	0.58	0.53	0.48	0.59	0.62	0.57	0.51	0.17	0.11	0.09	0.07	0.05	0.09	0.12	0.11	0.1	0.08	0.09	0.1	0.11	0.1	0.09	0.09	0.1	0.11	0.1	0.1	0.08	0.1	0.11	0.11	0.09	0.09	0.11	0.11	0.1	0.09
PRE1_21	0.53	0.59	0.61	0.59	0.54	0.52	0.59	0.62	0.57	0.56	0.51	0.59	0.64	0.6	0.51	0.56	0.6	0.6	0.6	0.49	1	0.69	0.51	0.37	0.28	0.53	0.6	0.64	0.58	0.5	0.18	0.11	0.09	0.07	0.05	0.09	0.11	0.1	0.1	0.08	0.09	0.11	0.1	0.1	0.09	0.08	0.1	0.11	0.11	0.09	0.09	0.1	0.11	0.11	0.08	0.08	0.1	0.11	0.11	0.09
PRE1_22	0.59	0.68	0.7	0.67	0.59	0.6	0.68	0.7	0.69	0.59	0.58	0.68	0.72	0.69	0.58	0.61	0.68	0.71	0.67	0.58	0.69	1	0.68	0.49	0.38	0.6	0.68	0.71	0.67	0.59	0.21	0.14	0.1	0.08	0.05	0.1	0.13	0.12	0.12	0.1	0.1	0.12	0.12	0.12	0.11	0.1	0.12	0.12	0.12	0.11	0.1	0.11	0.12	0.13	0.1	0.09	0.12	0.12	0.13	0.1
PRE1_23	0.6	0.7	0.74	0.7	0.61	0.63	0.7	0.72	0.69	0.61	0.6	0.7	0.73	0.71	0.6	0.61	0.69	0.74	0.7	0.59	0.51	0.68	1	0.66	0.5	0.58	0.7	0.72	0.71	0.63	0.19	0.13	0.1	0.08	0.06	0.11	0.13	0.12	0.11	0.1	0.1	0.12	0.12	0.11	0.11	0.1	0.11	0.13	0.12	0.1	0.11	0.11	0.12	0.11	0.1	0.11	0.12	0.11	0.12	0.1
PRE1_24	0.58	0.66	0.69	0.67	0.59	0.59	0.68	0.68	0.66	0.58	0.58	0.67	0.69	0.66	0.58	0.59	0.67	0.7	0.65	0.58	0.37	0.49	0.66	1	0.67	0.56	0.66	0.68	0.67	0.62	0.2	0.14	0.1	0.08	0.06	0.1	0.13	0.14	0.12	0.1	0.11	0.12	0.12	0.13	0.11	0.11	0.12	0.13	0.12	0.1	0.11	0.12	0.13	0.12	0.11	0.11	0.13	0.12	0.12	0.1
PRE1_25	0.52	0.59	0.61	0.59	0.51	0.53	0.58	0.61	0.59	0.51	0.54	0.59	0.58	0.59	0.53	0.53	0.58	0.6	0.59	0.53	0.28	0.38	0.5	0.67	1	0.51	0.59	0.61	0.58	0.54	0.19	0.12	0.1	0.08	0.06	0.09	0.13	0.13	0.11	0.08	0.1	0.11	0.11	0.12	0.1	0.1	0.11	0.11	0.12	0.11	0.1	0.11	0.12	0.12	0.1	0.1	0.12	0.11	0.11	0.1
PRE1_26	0.5	0.59	0.6	0.57	0.52	0.52	0.57	0.61	0.58	0.52	0.51	0.58	0.6	0.59	0.51	0.56	0.58	0.58	0.57	0.48	0.53	0.6	0.58	0.56	0.51	1	0.65	0.5	0.35	0.28	0.18	0.11	0.08	0.06	0.03	0.08	0.1	0.1	0.1	0.08	0.08	0.09	0.09	0.1	0.09	0.08	0.1	0.09	0.09	0.09	0.09	0.09	0.1	0.1	0.08	0.09	0.1	0.09	0.09	0.08
PRE1_27	0.59	0.67	0.69	0.68	0.59	0.6	0.67	0.69	0.66	0.61	0.56	0.68	0.69	0.69	0.61	0.6	0.65	0.69	0.68	0.59	0.6	0.68	0.7	0.66	0.59	0.65	1	0.67	0.5	0.41	0.22	0.14	0.1	0.09	0.06	0.1	0.14	0.13	0.12	0.11	0.11	0.12	0.12	0.12	0.12	0.11	0.13	0.13	0.12	0.11	0.12	0.11	0.13	0.13	0.11	0.11	0.13	0.13	0.13	0.1
PRE1_28	0.61	0.7	0.73	0.71	0.62	0.63	0.72	0.74	0.67	0.61	0.59	0.7	0.75	0.71	0.61	0.61	0.7	0.73	0.7	0.62	0.64	0.71	0.72	0.68	0.61	0.5	0.67	1	0.67	0.52	0.21	0.14	0.11	0.09	0.06	0.11	0.14	0.13	0.12	0.1	0.12	0.13	0.12	0.12	0.11	0.11	0.12	0.13	0.13	0.11	0.11	0.12	0.13	0.13	0.11	0.11	0.13	0.13	0.13	0.1
PRE1_29	0.58	0.67	0.7	0.67	0.58	0.58	0.69	0.69	0.68	0.58	0.58	0.68	0.7	0.68	0.56	0.59	0.67	0.71	0.67	0.57	0.58	0.67	0.71	0.67	0.58	0.35	0.5	0.67	1	0.68	0.19	0.12	0.1	0.09	0.06	0.09	0.13	0.13	0.11	0.09	0.1	0.11	0.12	0.12	0.1	0.11	0.11	0.12	0.12	0.1	0.1	0.11	0.12	0.11	0.1	0.09	0.12	0.12	0.12	0.1
PRE1_30	0.53	0.6	0.62	0.6	0.54	0.54	0.59	0.6	0.61	0.53	0.55	0.6	0.62	0.58	0.52	0.53	0.61	0.63	0.6	0.51	0.5	0.59	0.63	0.62	0.54	0.28	0.41	0.52	0.68	1	0.18	0.12	0.1	0.08	0.07	0.1	0.12	0.13	0.11	0.09	0.1	0.11	0.12	0.11	0.1	0.09	0.11	0.12	0.12	0.1	0.1	0.11	0.13	0.11	0.09	0.09	0.12	0.12	0.12	0.1
POST1_1	0.34	0.23	0.17	0.13	0.1	0.18	0.2	0.2	0.2	0.18	0.18	0.21	0.21	0.2	0.17	0.18	0.19	0.21	0.2	0.17	0.18	0.21	0.19	0.2	0.19	0.18	0.22	0.21	0.19	0.18	1	0.66	0.48	0.36	0.28	0.49	0.58	0.59	0.58	0.52	0.51	0.56	0.59	0.58	0.53	0.49	0.59	0.61	0.58	0.5	0.51	0.59	0.59	0.57	0.51	0.51	0.59	0.6	0.57	0.51
POST1_2	0.22	0.15	0.11	0.08	0.06	0.12	0.12	0.12	0.14	0.13	0.11	0.13	0.14	0.13	0.11	0.11	0.12	0.15	0.13	0.11	0.11	0.14	0.13	0.14	0.12	0.11	0.14	0.14	0.12	0.12	0.66	1	0.67	0.49	0.37	0.57	0.67	0.69	0.68	0.58	0.57	0.66	0.69	0.67	0.6	0.59	0.69	0.69	0.66	0.57	0.59	0.67	0.71	0.66	0.55	0.57	0.67	0.7	0.67	0.59
POST1_3	0.16	0.11	0.09	0.06	0.07	0.08	0.09	0.09	0.12	0.1	0.09	0.1	0.1	0.1	0.09	0.08	0.1	0.12	0.1	0.09	0.09	0.1	0.1	0.1	0.1	0.08	0.1	0.11	0.1	0.1	0.48	0.67	1	0.68	0.48	0.58	0.7	0.72	0.7	0.61	0.6	0.7	0.72	0.7	0.6	0.6	0.71	0.73	0.69	0.59	0.61	0.7	0.74	0.69	0.58	0.6	0.7	0.73	0.69	0.61
POST1_4	0.12	0.09	0.07	0.06	0.05	0.06	0.07	0.07	0.11	0.1	0.07	0.09	0.09	0.08	0.07	0.07	0.09	0.09	0.08	0.07	0.07	0.08	0.08	0.08	0.08	0.06	0.09	0.09	0.09	0.08	0.36	0.49	0.68	1	0.66	0.56	0.68	0.69	0.67	0.58	0.57	0.68	0.7	0.67	0.57	0.59	0.68	0.7	0.66	0.56	0.6	0.66	0.71	0.66	0.56	0.58	0.67	0.69	0.66	0.59
POST1_5	0.09	0.07	0.05	0.04	0.03	0.04	0.04	0.05	0.08	0.06	0.04	0.06	0.07	0.05	0.05	0.04	0.05	0.07	0.06	0.05	0.05	0.05	0.06	0.06	0.06	0.03	0.06	0.06	0.06	0.07	0.28	0.37	0.48	0.66	1	0.51	0.58	0.6	0.58	0.51	0.51	0.58	0.6	0.58	0.51	0.52	0.59	0.59	0.58	0.51	0.53	0.58	0.6	0.57	0.5	0.5	0.57	0.59	0.59	0.54
POST1_6	0.16	0.12	0.08	0.06	0.06	0.08	0.09	0.09	0.12	0.1	0.09	0.11	0.11	0.09	0.08	0.09	0.1	0.11	0.09	0.09	0.09	0.1	0.11	0.1	0.09	0.08	0.1	0.11	0.09	0.1	0.49	0.57	0.58	0.56	0.51	1	0.66	0.46	0.36	0.25	0.49	0.55	0.59	0.57	0.51	0.49	0.58	0.59	0.56	0.5	0.51	0.57	0.58	0.57	0.48	0.49	0.56	0.58	0.56	0.53
POST1_7	0.2	0.14	0.11	0.08	0.08	0.11	0.12	0.12	0.14	0.13	0.1	0.14	0.14	0.13	0.11	0.12	0.12	0.14	0.13	0.12	0.11	0.13	0.13	0.13	0.13	0.1	0.14	0.14	0.13	0.12	0.58	0.67	0.7	0.68	0.58	0.66	1	0.68	0.5	0.38	0.58	0.67	0.7	0.68	0.57	0.56	0.69	0.71	0.68	0.58	0.6	0.69	0.71	0.66	0.56	0.58	0.67	0.71	0.68	0.59
POST1_8	0.2	0.14	0.11	0.09	0.07	0.11	0.12	0.12	0.14	0.13	0.1	0.13	0.14	0.13	0.11	0.11	0.12	0.14	0.14	0.11	0.1	0.12	0.12	0.14	0.13	0.1	0.13	0.13	0.13	0.13	0.59	0.69	0.72	0.69	0.6	0.46	0.68	1	0.67	0.49	0.6	0.69	0.71	0.7	0.6	0.6	0.71	0.72	0.68	0.58	0.61	0.7	0.74	0.68	0.57	0.59	0.68	0.73	0.7	0.6
POST1_9	0.2	0.13	0.1	0.08	0.05	0.1	0.1	0.11	0.13	0.12	0.1	0.12	0.12	0.11	0.1	0.1	0.12	0.13	0.12	0.1	0.1	0.12	0.11	0.12	0.11	0.1	0.12	0.12	0.11	0.11	0.58	0.68	0.7	0.67	0.58	0.36	0.5	0.67	1	0.67	0.57	0.67	0.7	0.67	0.6	0.61	0.68	0.7	0.66	0.56	0.6	0.67	0.71	0.68	0.56	0.58	0.67	0.7	0.66	0.6
POST1_10	0.17	0.11	0.09	0.05	0.05	0.08	0.09	0.09	0.11	0.1	0.09	0.1	0.1	0.09	0.08	0.08	0.1	0.12	0.1	0.08	0.08	0.1	0.1	0.1	0.08	0.08	0.11	0.1	0.09	0.09	0.52	0.58	0.61	0.58	0.51	0.25	0.38	0.49	0.67	1	0.51	0.59	0.6	0.57	0.53	0.53	0.59	0.59	0.58	0.52	0.52	0.58	0.61	0.57	0.53	0.53	0.6	0.59	0.58	0.51
POST1_11	0.18	0.12	0.08	0.07	0.05	0.09	0.09	0.1	0.12	0.11	0.09	0.11	0.12	0.1	0.08	0.09	0.1	0.13	0.11	0.09	0.09	0.1	0.1	0.11	0.1	0.08	0.11	0.12	0.1	0.1	0.51	0.57	0.6	0.57	0.51	0.49	0.58	0.6	0.57	0.51	1	0.65	0.46	0.37	0.28	0.49	0.58	0.62	0.57	0.5	0.52	0.59	0.61	0.56	0.49	0.51	0.57	0.6	0.57	0.52
POST1_12	0.19	0.13	0.1	0.08	0.07	0.1	0.11	0.11	0.13	0.12	0.1	0.13	0.13	0.11	0.09	0.1	0.12	0.13	0.12	0.1	0.11	0.12	0.12	0.12	0.11	0.09	0.12	0.13	0.11	0.11	0.56	0.66	0.7	0.68	0.58	0.55	0.67	0.69	0.67	0.59	0.65	1	0.66	0.49	0.38	0.57	0.68	0.69	0.68	0.56	0.6	0.67	0.7	0.65	0.57	0.56	0.66	0.69	0.67	0.6
POST1_13	0.19	0.13	0.1	0.08	0.07	0.1	0.11	0.11	0.13	0.12	0.1	0.12	0.13	0.12	0.1	0.1	0.11	0.13	0.12	0.11	0.1	0.12	0.12	0.12	0.11	0.09	0.12	0.12	0.12	0.12	0.59	0.69	0.72	0.7	0.6	0.59	0.7	0.71	0.7	0.6	0.46	0.66	1	0.68	0.5	0.61	0.69	0.71	0.68	0.59	0.61	0.69	0.72	0.69	0.59	0.59	0.69	0.73	0.68	0.6
POST1_14	0.19	0.13	0.11	0.08	0.07	0.1	0.11	0.11	0.14	0.12	0.1	0.12	0.12	0.12	0.11	0.1	0.12	0.13	0.12	0.1	0.1	0.12	0.11	0.13	0.12	0.1	0.12	0.12	0.12	0.11	0.58	0.67	0.7	0.67	0.58	0.57	0.68	0.7	0.67	0.57	0.37	0.49	0.68	1	0.67	0.59	0.7	0.69	0.65	0.57	0.59	0.67	0.71	0.67	0.56	0.59	0.67	0.68	0.67	0.59
POST1_15	0.18	0.13	0.1	0.06	0.05	0.09	0.11	0.11	0.12	0.1	0.09	0.11	0.11	0.11	0.1	0.1	0.11	0.12	0.1	0.09	0.09	0.11	0.11	0.11	0.1	0.09	0.12	0.11	0.1	0.1	0.53	0.6	0.6	0.57	0.51	0.51	0.57	0.6	0.6	0.53	0.28	0.38	0.5	0.67	1	0.52	0.61	0.6	0.57	0.52	0.53	0.6	0.61	0.58	0.49	0.51	0.6	0.61	0.58	0.52
POST1_16	0.15	0.11	0.09	0.07	0.07	0.09	0.09	0.09	0.12	0.1	0.09	0.11	0.11	0.1	0.08	0.09	0.09	0.12	0.11	0.09	0.08	0.1	0.1	0.11	0.1	0.08	0.11	0.11	0.11	0.09	0.49	0.59	0.6	0.59	0.52	0.49	0.56	0.6	0.61	0.53	0.49	0.57	0.61	0.59	0.52	1	0.68	0.49	0.34	0.27	0.53	0.58	0.6	0.58	0.49	0.5	0.59	0.6	0.58	0.52
POST1_17	0.19	0.14	0.11	0.07	0.06	0.1	0.11	0.11	0.13	0.11	0.1	0.12	0.12	0.12	0.1	0.1	0.11	0.13	0.12	0.1	0.1	0.12	0.11	0.12	0.11	0.1	0.13	0.12	0.11	0.11	0.59	0.69	0.71	0.68	0.59	0.58	0.69	0.71	0.68	0.59	0.58	0.68	0.69	0.7	0.61	0.68	1	0.69	0.51	0.37	0.61	0.68	0.72	0.68	0.56	0.59	0.68	0.72	0.68	0.59
POST1_18	0.21	0.14	0.11	0.08	0.06	0.1	0.11	0.12	0.14	0.12	0.11	0.14	0.13	0.12	0.1	0.1	0.12	0.14	0.13	0.11	0.11	0.12	0.13	0.13	0.11	0.09	0.13	0.13	0.12	0.12	0.61	0.69	0.73	0.7	0.59	0.59	0.71	0.72	0.7	0.59	0.62	0.69	0.71	0.69	0.6	0.49	0.69	1	0.68	0.47	0.6	0.71	0.73	0.69	0.58	0.6	0.68	0.73	0.7	0.61
POST1_19	0.2	0.14	0.1	0.08	0.06	0.1	0.11	0.11	0.13	0.13	0.1	0.12	0.13	0.12	0.1	0.11	0.12	0.13	0.11	0.1	0.11	0.12	0.12	0.12	0.12	0.09	0.12	0.13	0.12	0.12	0.58	0.66	0.69	0.66	0.58	0.56	0.68	0.68	0.66	0.58	0.57	0.68	0.68	0.65	0.57	0.34	0.51	0.68	1	0.63	0.58	0.67	0.7	0.64	0.57	0.58	0.67	0.68	0.65	0.58
POST1_20	0.18	0.12	0.09	0.07	0.06	0.09	0.1	0.1	0.12	0.11	0.08	0.11	0.12	0.11	0.1	0.09	0.11	0.12	0.1	0.1	0.09	0.11	0.1	0.1	0.11	0.09	0.11	0.11	0.1	0.1	0.5	0.57	0.59	0.56	0.51	0.5	0.58	0.58	0.56	0.52	0.5	0.56	0.59	0.57	0.52	0.27	0.37	0.47	0.63	1	0.51	0.57	0.6	0.56	0.5	0.5	0.56	0.58	0.56	0.54
POST1_21	0.17	0.12	0.09	0.07	0.06	0.09	0.1	0.1	0.12	0.11	0.09	0.11	0.11	0.11	0.1	0.1	0.11	0.11	0.11	0.08	0.09	0.1	0.11	0.11	0.1	0.09	0.12	0.11	0.1	0.1	0.51	0.59	0.61	0.6	0.53	0.51	0.6	0.61	0.6	0.52	0.52	0.6	0.61	0.59	0.53	0.53	0.61	0.6	0.58	0.51	1	0.68	0.51	0.36	0.26	0.52	0.58	0.6	0.58	0.55
POST1_22	0.2	0.14	0.09	0.06	0.05	0.1	0.1	0.1	0.12	0.12	0.1	0.12	0.13	0.11	0.09	0.09	0.12	0.13	0.11	0.1	0.1	0.11	0.11	0.12	0.11	0.09	0.11	0.12	0.11	0.11	0.59	0.67	0.7	0.66	0.58	0.57	0.69	0.7	0.67	0.58	0.59	0.67	0.69	0.67	0.6	0.58	0.68	0.71	0.67	0.57	0.68	1	0.68	0.48	0.36	0.58	0.68	0.7	0.67	0.6
POST1_23	0.2	0.14	0.11	0.08	0.07	0.11	0.11	0.12	0.14	0.12	0.1	0.13	0.13	0.13	0.11	0.1	0.12	0.14	0.12	0.11	0.11	0.12	0.12	0.13	0.12	0.1	0.13	0.13	0.12	0.13	0.59	0.71	0.74	0.71	0.6	0.58	0.71	0.74	0.71	0.61	0.61	0.7	0.72	0.71	0.61	0.6	0.72	0.73	0.7	0.6	0.51	0.68	1	0.68	0.46	0.6	0.71	0.75	0.7	0.6
POST1_24	0.19	0.13	0.11	0.08	0.07	0.1	0.11	0.11	0.14	0.12	0.1	0.13	0.13	0.12	0.1	0.1	0.11	0.14	0.12	0.11	0.11	0.13	0.11	0.12	0.12	0.1	0.13	0.13	0.11	0.11	0.57	0.66	0.69	0.66	0.57	0.57	0.66	0.68	0.68	0.57	0.56	0.65	0.69	0.67	0.58	0.58	0.68	0.69	0.64	0.56	0.36	0.48	0.68	1	0.64	0.57	0.66	0.69	0.66	0.57
POST1_25	0.17	0.12	0.09	0.06	0.06	0.09	0.1	0.1	0.11	0.11	0.09	0.12	0.12	0.1	0.08	0.1	0.1	0.11	0.1	0.09	0.08	0.1	0.1	0.11	0.1	0.08	0.11	0.11	0.1	0.09	0.51	0.55	0.58	0.56	0.5	0.48	0.56	0.57	0.56	0.53	0.49	0.57	0.59	0.56	0.49	0.49	0.56	0.58	0.57	0.5	0.26	0.36	0.46	0.64	1	0.49	0.55	0.57	0.56	0.53
POST1_26	0.18	0.13	0.09	0.06	0.04	0.08	0.09	0.1	0.11	0.11	0.08	0.11	0.11	0.11	0.09	0.09	0.1	0.11	0.11	0.09	0.08	0.09	0.11	0.11	0.1	0.09	0.11	0.11	0.09	0.09	0.51	0.57	0.6	0.58	0.5	0.49	0.58	0.59	0.58	0.53	0.51	0.56	0.59	0.59	0.51	0.5	0.59	0.6	0.58	0.5	0.52	0.58	0.6	0.57	0.49	1	0.66	0.48	0.35	0.28
POST1_27	0.2	0.14	0.11	0.08	0.07	0.1	0.12	0.12	0.14	0.12	0.11	0.13	0.13	0.12	0.11	0.11	0.12	0.14	0.12	0.11	0.1	0.12	0.12	0.13	0.12	0.1	0.13	0.13	0.12	0.12	0.59	0.67	0.7	0.67	0.57	0.56	0.67	0.68	0.67	0.6	0.57	0.66	0.69	0.67	0.6	0.59	0.68	0.68	0.67	0.56	0.58	0.68	0.71	0.66	0.55	0.66	1	0.68	0.47	0.39
POST1_28	0.2	0.13	0.1	0.08	0.07	0.11	0.11	0.11	0.13	0.12	0.1	0.13	0.13	0.11	0.11	0.1	0.12	0.13	0.12	0.11	0.11	0.12	0.11	0.12	0.11	0.09	0.13	0.13	0.12	0.12	0.6	0.7	0.73	0.69	0.59	0.58	0.71	0.73	0.7	0.59	0.6	0.69	0.73	0.68	0.61	0.6	0.72	0.73	0.68	0.58	0.6	0.7	0.75	0.69	0.57	0.48	0.68	1	0.67	0.49
POST1_29	0.19	0.13	0.11	0.08	0.07	0.11	0.11	0.11	0.14	0.12	0.1	0.12	0.13	0.13	0.1	0.11	0.12	0.14	0.12	0.1	0.11	0.13	0.12	0.12	0.11	0.09	0.13	0.13	0.12	0.12	0.57	0.67	0.69	0.66	0.59	0.56	0.68	0.7	0.66	0.58	0.57	0.67	0.68	0.67	0.58	0.58	0.68	0.7	0.65	0.56	0.58	0.67	0.7	0.66	0.56	0.35	0.47	0.67	1	0.67
POST1_30	0.16	0.12	0.09	0.06	0.06	0.08	0.09	0.1	0.12	0.1	0.09	0.11	0.11	0.1	0.08	0.08	0.1	0.12	0.1	0.09	0.09	0.1	0.1	0.1	0.1	0.08	0.1	0.1	0.1	0.1	0.51	0.59	0.61	0.59	0.54	0.53	0.59	0.6	0.6	0.51	0.52	0.6	0.6	0.59	0.52	0.52	0.59	0.61	0.58	0.54	0.55	0.6	0.6	0.57	0.53	0.28	0.39	0.49	0.67	1

# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(PP_30.30[pre_30mzp])
POST_alpha = CronbachAlpha(PP_30.30[post_30mzp])
PP_30.30_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))

Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.179.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.65.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.64.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.978.

---

1.3.3 PP_1.1 (je 1 MZP)

PP_1.1_rtt = cor(PP_1.1$PRE, PP_1.1$POST)
PP_1.1_Alpha = CronbachAlpha(PP_1.1[c("PRE","POST")])

Korrelation zwischen den Pre- und Post-MZP (Retest-Reliabilität) = 0.336.
Cronbach´s Alpha zwischen dem Pre- und dem Post-MZP = 0.494.

---

1.4 Pre-Post-Differenz

Verteilungen der Pre-Post-(Mittelwerts-)Veränderungen

#hist(PP_5.5$MeanDiff, col = "lightblue1", main = paste0("Mittlere Pre-Post-Intervall-Differenz in PP_5.5 = ",
#  round(mean(PP_5.5$MeanDiff), digits = 3)))

#hist(PP_30.30$MeanDiff, col = "lightblue1", main = paste0("Mittlere Pre-Post-Intervall-Differenz in PP_30.30 = ",
#  round(mean(PP_30.30$MeanDiff), digits = 3)))

#hist(PP_1.1$Diff, col = "lightblue1", main = paste0("Mittlere Pre-Post-Differenz in PP_1.1 = ", 
#  round(mean(PP_1.1$Diff), digits = 3)))

temp = tibble(MeanDiffs = c(PP_5.5$MeanDiff, PP_30.30$MeanDiff, PP_1.1$Diff),
              Datasets = rep(c("PP_5.5", "PP_30.30", "PP_1.1"), each = length(PP_5.5$MeanDiff)))

temp %>%
  ggplot(aes(x = MeanDiffs, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(title = "Pre-Post-Differences", x = "PHQ-9 Pre-Post-Difference")

scatter.hist(PP_1.1$Diff, PP_30.30$MeanDiff, xlab = "PP_1.1$Diff",
  ylab = "PP_30.30$MeanDiff", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation zwischen den Pre-Post-Differenzen in PP_1.1 und PP_30.30 = 0.638.

Prozentuale Überlappung der Pre-Post-(Mittelwerts-)Veränderungen

# Overlap-Plots zum Vergleich
final.plot(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_30.30_MeanDiff = PP_30.30$MeanDiff), 
           overlap(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_30.30_MeanDiff = PP_30.30$MeanDiff))$OV)

final.plot(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_1.1_Diff = PP_1.1$Diff), 
           overlap(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_1.1_Diff = PP_1.1$Diff))$OV)

final.plot(list(PP_30.30_MeanDiff = PP_30.30$MeanDiff, PP_1.1_Diff = PP_1.1$Diff), 
           overlap(list(PP_30.30_MeanDiff = PP_30.30$MeanDiff, PP_1.1_Diff = PP_1.1$Diff))$OV)

---

1.4.1 Cohen´s d

Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in den Original-Simulationsdaten (je 5 MZP)

\[ d = \frac{\overline{x_{1}} - \overline{x_{2}}} {\sqrt{0.5 \cdot (s_{x}^2 + s_{y}^2)}} \]

\(\overline{x_{1}}\) = mean of subject´s pretest scores, \(\overline{x_{2}}\) = mean of subject´s posttest scores, \(s_{x}\) = individual standard deviation of pretest time points, \(s_{y}\) = individual standard deviation of posttest time points

PP_5.5$Cohen_d = (PP_5.5$PRE_Mean - PP_5.5$POST_Mean) / sqrt(0.5 * (PP_5.5$ind.pretestSD^2 + PP_5.5$ind.posttestSD^2))

# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>% 
#  within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})

hist(PP_5.5$Cohen_d, col = "lightblue1", main = "PP_5.5$Cohen_d")

cohen_d_5.5 = (mean(PP_5.5$PRE_Mean) - mean(PP_5.5$POST_Mean)) / sqrt(0.5 * (mean(PP_5.5$ind.pretestSD)^2 +
  mean(PP_5.5$ind.posttestSD)^2))

final.plot(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_5.5_POST_Mean = PP_5.5$POST_Mean), 
           overlap(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_5.5_POST_Mean = PP_5.5$POST_Mean))$OV)

Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in PP_5.5 = 4.031.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in PP_5.5 = 1.697.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in PP_5.5 = 1.416.

---

Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in den erweiterten Intervall-Daten (je 30 MZP)

PP_30.30$Cohen_d = (PP_30.30$PRE_Mean - PP_30.30$POST_Mean) / sqrt(0.5 * (PP_30.30$ind.pretestSD^2 +
  PP_30.30$ind.posttestSD^2))

# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>% 
#  within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})

hist(PP_30.30$Cohen_d, col = "lightblue1", main = "PP_30.30$Cohen_d")

cohen_d_30.30 = (mean(PP_30.30$PRE_Mean) - mean(PP_30.30$POST_Mean)) / sqrt(0.5 * (mean(PP_30.30$ind.pretestSD)^2 + mean(PP_30.30$ind.posttestSD)^2))

final.plot(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_30.30_POST_Mean = PP_30.30$POST_Mean), 
           overlap(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_30.30_POST_Mean =
                          PP_30.30$POST_Mean))$OV)

Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in PP_30.30 = 4.031.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in PP_30.30 = 1.866.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in PP_30.30 = 1.556.

---

Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-MZP in der Stichprobe mit je 1 MZP

\[ d = \frac{\overline{X_{1}} - \overline{X_{2}}} {\sqrt{0.5 \cdot (s_{X}^2 + s_{Y}^2)}} \]

\(\overline{X_{1}}\) = mean of pretest scores in the whole sample, \(\overline{X_{2}}\) = mean of posttest scores in the whole sample, \(s_{X}\) = standard deviation of pretest scores in the whole sample, \(s_{Y}\) = standard deviation of posttest scores in the whole sample

cohen_d_1.1 = (mean(PP_1.1$PRE) - mean(PP_1.1$POST)) / sqrt(0.5 * (sd(PP_1.1$PRE)^2 + sd(PP_1.1$POST)^2))

final.plot(list(PP_1.1_PRE = PP_1.1$PRE, PP_1.1_POST = PP_1.1$POST), 
           overlap(list(PP_1.1_PRE = PP_1.1$PRE, PP_1.1_POST = PP_1.1$POST))$OV)

Gepoolte Varianz zwischen dem Pre- und Post-MZP in PP_1.1 = 5.074.
Durchschnittliches Cohen´s d zwischen dem Pre- und Post-MZP in PP_1.1 = 0.916.

---

1.5 Klinische PHQ-9-Interpretation

PHQ_Int = tibble(PHQ_Score = c("0-4","5-9","10-14","15-19","20-27"),
       Klassifikation = c(0,1,2,3,4),
       Interpretation = c("Minimal or none","Mild","Moderate","Moderately severe","Severe"))

1.5.1 PP_5.5

PP_5.5 = PP_5.5 %>% 
  mutate(PRE_Mean_klass = case_when(
    PRE_Mean <= 4 ~ 0,
    PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
    PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
    PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
    PRE_Mean >= 20 ~ 4,
    TRUE ~ PRE_Mean
  )
)

temp = PP_5.5 %>% 
  dplyr::count(PRE_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

PHQ_Score	PRE_Mean_klass	Interpretation	n	Percentage
0-4	0	Minimal or none	3	0.04
5-9	1	Mild	3598	43.74
10-14	2	Moderate	4384	53.29
15-19	3	Moderately severe	241	2.93
20-27	4	Severe	NA	NA

PP_5.5 = PP_5.5 %>% 
  mutate(POST_Mean_klass = case_when(
    POST_Mean <= 4 ~ 0,
    POST_Mean > 4 & POST_Mean < 10 ~ 1,
    POST_Mean >= 10 & POST_Mean < 15 ~ 2,
    POST_Mean >= 15 & POST_Mean < 20 ~ 3,
    POST_Mean >= 20 ~ 4,
    TRUE ~ POST_Mean
  )
)

temp = PP_5.5 %>% 
  dplyr::count(POST_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(POST_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

PHQ_Score	POST_Mean_klass	Interpretation	n	Percentage
0-4	0	Minimal or none	1691	20.56
5-9	1	Mild	4795	58.29
10-14	2	Moderate	1718	20.88
15-19	3	Moderately severe	22	0.27
20-27	4	Severe	NA	NA

temp = tibble(Klassifikation = c(PP_5.5$PRE_Mean_klass, PP_5.5$POST_Mean_klass),
              MZP = rep(c("PRE_Mean_klass", "POST_Mean_klass"), each = length(PP_5.5$PRE_Mean_klass)))

temp %>%
  ggplot(aes(x = Klassifikation, fill = MZP)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(title = "PP_5.5: PHQ-9 Classification", x = "Classification")

---

1.5.2 PP_30.30

PP_30.30 = PP_30.30 %>% 
  mutate(PRE_Mean_klass = case_when(
    PRE_Mean <= 4 ~ 0,
    PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
    PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
    PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
    PRE_Mean >= 20 ~ 4,
    TRUE ~ PRE_Mean
  )
)

temp = PP_30.30 %>% 
  dplyr::count(PRE_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

PHQ_Score	PRE_Mean_klass	Interpretation	n	Percentage
0-4	0	Minimal or none	3	0.04
5-9	1	Mild	3598	43.74
10-14	2	Moderate	4384	53.29
15-19	3	Moderately severe	241	2.93
20-27	4	Severe	NA	NA

PP_30.30 = PP_30.30 %>% 
  mutate(POST_Mean_klass = case_when(
    POST_Mean <= 4 ~ 0,
    POST_Mean > 4 & POST_Mean < 10 ~ 1,
    POST_Mean >= 10 & POST_Mean < 15 ~ 2,
    POST_Mean >= 15 & POST_Mean < 20 ~ 3,
    POST_Mean >= 20 ~ 4,
    TRUE ~ POST_Mean
  )
)

temp = PP_30.30 %>% 
  dplyr::count(POST_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(POST_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

PHQ_Score	POST_Mean_klass	Interpretation	n	Percentage
0-4	0	Minimal or none	1691	20.56
5-9	1	Mild	4795	58.29
10-14	2	Moderate	1718	20.88
15-19	3	Moderately severe	22	0.27
20-27	4	Severe	NA	NA

temp = tibble(Klassifikation = c(PP_30.30$PRE_Mean_klass, PP_30.30$POST_Mean_klass),
              MZP = rep(c("PRE_Mean_klass", "POST_Mean_klass"), each = length(PP_30.30$PRE_Mean_klass)))

temp %>%
  ggplot(aes(x = Klassifikation, fill = MZP)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(title = "PP_30.30: PHQ-9 Classification", x = "Classification")

---

1.5.3 PP_1.1

PP_1.1 = PP_1.1 %>% 
  mutate(PRE_klass = case_when(
    PRE <= 4 ~ 0,
    PRE > 4 & PRE < 10 ~ 1,
    PRE >= 10 & PRE < 15 ~ 2,
    PRE >= 15 & PRE < 20 ~ 3,
    PRE >= 20 ~ 4,
    TRUE ~ as.numeric(PRE)
  )
)

temp = PP_1.1 %>% 
  dplyr::count(PRE_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(PRE_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

PHQ_Score	PRE_klass	Interpretation	n	Percentage
0-4	0	Minimal or none	258	3.14
5-9	1	Mild	2992	36.37
10-14	2	Moderate	4303	52.31
15-19	3	Moderately severe	639	7.77
20-27	4	Severe	34	0.41

PP_1.1 = PP_1.1 %>% 
  mutate(POST_klass = case_when(
    POST <= 4 ~ 0,
    POST > 4 & POST < 10 ~ 1,
    POST >= 10 & POST < 15 ~ 2,
    POST >= 15 & POST < 20 ~ 3,
    POST >= 20 ~ 4,
    TRUE ~ as.numeric(POST)
  )
)

temp = PP_1.1 %>% 
  dplyr::count(POST_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(POST_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

PHQ_Score	POST_klass	Interpretation	n	Percentage
0-4	0	Minimal or none	2495	30.33
5-9	1	Mild	3606	43.84
10-14	2	Moderate	1733	21.07
15-19	3	Moderately severe	382	4.64
20-27	4	Severe	10	0.12

temp = tibble(Klassifikation = c(PP_1.1$PRE_klass, PP_1.1$POST_klass),
              MZP = rep(c("PRE_klass", "POST_klass"), each = length(PP_1.1$PRE_klass)))

temp %>%
  ggplot(aes(x = Klassifikation, fill = MZP)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(title = "PP_1.1: PHQ-9 Classification", x = "Classification")

---

1.6 Percentage Change (PC)

\[ PC = \Bigl(1 - \frac{\overline{x_{2}}} {\overline{x_{1}}}\Bigr) \cdot 100 \]

\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores

Interpretation des Percentage Change:

PC_Int = tibble(PC = c("PC <= -50","-50 < PC <= -25","-25 < PC < 25","25 <= PC < 50","PC >= 50"),
                Klassifikation = c(-2,-1,0,1,2),
                Interpretation = c("starke Verschlechterung","Verschlechterung","keine Veränderung",
                                   "Verbesserung","starke Verbesserung"))

1.6.1 PP_5.5

PP_5.5$Mean_PC = (1-(PP_5.5$POST_Mean / PP_5.5$PRE_Mean)) * 100

# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>% 
#  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

PP_5.5 = PP_5.5 %>% 
  mutate(Mean_PC_klass = case_when(
    Mean_PC <= -50 ~ -2,
    Mean_PC > -50 & Mean_PC <= -25 ~ -1,
    Mean_PC > -25 & Mean_PC < 25 ~ 0,
    Mean_PC >= 25 & Mean_PC < 50 ~ 1,
    Mean_PC >= 50 ~ 2,
    TRUE ~ Mean_PC
  )
)


temp = PP_5.5 %>% 
  dplyr::count(Mean_PC_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PC_Int %>%
  dplyr::rename(Mean_PC_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

PC	Mean_PC_klass	Interpretation	n	Percentage
PC <= -50	-2	starke Verschlechterung	225	2.74
-50 < PC <= -25	-1	Verschlechterung	391	4.75
-25 < PC < 25	0	keine Veränderung	2774	33.72
25 <= PC < 50	1	Verbesserung	2276	27.67
PC >= 50	2	starke Verbesserung	2560	31.12

x = PP_5.5 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

y = PP_5.5 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

scatter.hist(x$PRE_Mean, y$Mean_PC, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation Mean Percentage Change (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.375.

---

1.6.2 PP_30.30

PP_30.30$Mean_PC = (1-(PP_30.30$POST_Mean / PP_30.30$PRE_Mean)) * 100

# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>% 
#  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

PP_30.30 = PP_30.30 %>% 
  mutate(Mean_PC_klass = case_when(
    Mean_PC <= -50 ~ -2,
    Mean_PC > -50 & Mean_PC <= -25 ~ -1,
    Mean_PC > -25 & Mean_PC < 25 ~ 0,
    Mean_PC >= 25 & Mean_PC < 50 ~ 1,
    Mean_PC >= 50 ~ 2,
    TRUE ~ Mean_PC
  )
)


temp = PP_30.30 %>% 
  dplyr::count(Mean_PC_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PC_Int %>%
  dplyr::rename(Mean_PC_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

PC	Mean_PC_klass	Interpretation	n	Percentage
PC <= -50	-2	starke Verschlechterung	225	2.74
-50 < PC <= -25	-1	Verschlechterung	391	4.75
-25 < PC < 25	0	keine Veränderung	2774	33.72
25 <= PC < 50	1	Verbesserung	2276	27.67
PC >= 50	2	starke Verbesserung	2560	31.12

x = PP_30.30 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

y = PP_30.30 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

scatter.hist(x$PRE_Mean, y$Mean_PC, xlab = "PP_30.30$PRE_Mean", ylab = "PP_30.30$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation Mean Percentage Change (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.375.

---

1.6.3 PP_1.1

PP_1.1$PC = (1 - (PP_1.1$POST / PP_1.1$PRE)) * 100

# Sollen PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_1.1 = PP_1.1 %>% 
#  within(., {PC[PC %in% c(-Inf,Inf)] = NA})

PP_1.1 = PP_1.1 %>% 
  mutate(PC_klass = case_when(
    PC <= -50 ~ -2,
    PC > -50 & PC <= -25 ~ -1,
    PC > -25 & PC < 25 ~ 0,
    PC >= 25 & PC < 50 ~ 1,
    PC >= 50 ~ 2,
    TRUE ~ as.numeric(PC)
  )
)


temp = PP_1.1 %>% 
  dplyr::count(PC_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PC_Int %>%
  dplyr::rename(PC_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

PC	PC_klass	Interpretation	n	Percentage
PC <= -50	-2	starke Verschlechterung	175	2.13
-50 < PC <= -25	-1	Verschlechterung	624	7.59
-25 < PC < 25	0	keine Veränderung	2684	32.63
25 <= PC < 50	1	Verbesserung	1810	22.00
PC >= 50	2	starke Verbesserung	2933	35.66

x = PP_1.1 %>% 
  within(., {PC[PC %in% c(-Inf,Inf)] = NA})

y = PP_1.1 %>% 
  within(., {PC[PC %in% c(-Inf,Inf)] = NA})

scatter.hist(x$PRE, y$PC, xlab = "PP_1.1$PRE", ylab = "PP_1.1$PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation von Percentage Change (je 1 MZP) mit PHQ-Baseline (Pre-MZP) = 0.243.

---

1.6.4 Zusammenhang im Scatter-Histogramm

x = PP_5.5 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

y = PP_30.30 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

z = PP_1.1 %>% 
  within(., {PC[PC %in% c(-Inf,Inf)] = NA})

scatter.hist(x$Mean_PC, y$Mean_PC, xlab = "PP_5.5$Mean_PC", ylab = "PP_30.30$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

scatter.hist(y$Mean_PC, z$PC, xlab = "PP_30.30$Mean_PC", ylab = "PP_1.1$PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

scatter.hist(x$Mean_PC, z$PC, xlab = "PP_5.5$Mean_PC", ylab = "PP_1.1$PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

---

1.7 Reliable Change Index (JT)

\[ RCI = \frac{x_{2} - x_{1}} {s_{diff}} \]

\[ s_{diff} = \sqrt{2 \cdot (S_{E})^2} \]

\[ SE = s_{1} \cdot \sqrt{1 - r_{xx´}} \]

\[ \text{significance cutoff} = 1.96 \cdot s_{diff} = 1.96 \cdot \sqrt{2 \cdot (s_{1} \cdot \sqrt{1 - r_{xx´}})^2} \]

\(x_{2}\) = subject´s posttest score, \(x_{1}\) = subject´s pretest score, \(s_{diff}\) = standard error of difference between test scores, \(SE\) = standard error of measurement, \(s_{1}\) = standard deviation of test scores at pretest, \(r_{xx´}\) = reliability of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)

PP_5.5_RCI_JT_Mean = (mean(PP_5.5$POST_Mean) - mean(PP_5.5$PRE_Mean)) / sqrt(2 * (sd(PP_5.5$PRE_Mean) * sqrt(1 - PP_5.5_Alpha)) ^ 2)

PP_30.30_RCI_JT_Mean = (mean(PP_30.30$POST_Mean) - mean(PP_30.30$PRE_Mean)) / sqrt(2 * (sd(PP_30.30$PRE_Mean) * sqrt(1 - PP_5.5_Alpha)) ^ 2)

PP_1.1_RCI_JT_Mean = (mean(PP_1.1$POST) - mean(PP_1.1$PRE)) / sqrt(2 * (sd(PP_1.1$PRE) * sqrt(1 - 
  PP_5.5_Alpha)) ^ 2)

Durchschnittlicher RCI(JT) auf Stichproben-Ebene in PP_5.5 = -2.282.
Durchschnittlicher RCI(JT) auf Stichproben-Ebene in PP_30.30 = -2.282.
Durchschnittlicher RCI(JT) auf Stichproben-Ebene in PP_1.1 = -1.834.

RCI(JT) von einem Pre- zu einem Post-MZP (= original für jede Person individuell)

PP_1.1$RCI_JT = (PP_1.1$POST - PP_1.1$PRE) / sqrt(2 * (sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)) ^ 2)
RCI_JT_Cutoff = 1.96 * sqrt(2 * (sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)) ^ 2)

# Sollen RCI_JT %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_1.1 = PP_1.1 %>% 
#  within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})

x = PP_1.1 %>% 
  within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})

y = PP_1.1 %>% 
  within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})

scatter.hist(x$PRE, y$RCI_JT, xlab = "PP_1.1$PRE", ylab = "PP_1.1$RCI_JT", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation RCI_JT (je 1 MZP) mit PHQ-Baseline (Pre-MZP) = -0.451.
RCI(JT)-Cutoff für reliable Veränderung auf Gruppenebene (je 1 MZP) = 3.511.

Zwischenschritt vom RCI(JT) zum RCI(ind): Der Zähler in der Formel wird durch die Intervall-Differenz (5MZP Pre - 5MZP Post) ausgetauscht:

\[ RCI_{Zwischenstufe} = \frac{\overline{x_{2}} - \overline{x_{1}}} {s_{diff}} \]

\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores

PP_5.5$RCI_JT_ZwStufe = (PP_5.5$POST_Mean - PP_5.5$PRE_Mean) / sqrt(2 * (sd(PP_5.5$PRE1_1) * sqrt(1 - PP_5.5_Alpha)) ^ 2)

# Sollen RCI_JT_ZwStufe %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>% 
#  within(., {RCI_JT_ZwStufe[RCI_JT_ZwStufe %in% c(-Inf,Inf)] = NA})

x = PP_5.5 %>% 
  within(., {RCI_JT_ZwStufe[RCI_JT_ZwStufe %in% c(-Inf,Inf)] = NA})

y = PP_5.5 %>% 
  within(., {RCI_JT_ZwStufe[RCI_JT_ZwStufe %in% c(-Inf,Inf)] = NA})

scatter.hist(x$PRE_Mean, y$RCI_JT_ZwStufe, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$RCI_JT_ZwStufe", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation RCI_JT_ZwStufe (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.543.

---

1.8 Individual Reliable Change Index (ind)

1.8.1 RCI(ind) nur mit SD aus dem individuellen Pre-Intervall

\[ RCI_{ind,preSD} = \frac{\overline{x_{2}} - \overline{x_{1}}} {SE_{D,pre}} \]

\[ SE_{D,pre} = \sqrt{2 \cdot (s_{x} \cdot (1 - r_{xy})^2)} \]

\[ \text{significance cutoff} = 1.96 \cdot SE_{D,pre} = 1.96 \cdot \sqrt{2 \cdot (s_{x} \cdot (1 - r_{xy})^2)} \]

\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores, \(SE_{D,pre}\) = standard error of difference between the test scores in the individual´s pre interval \(s_{x}\) = individual standard deviation of pretest time points, \(r_{xy}\) = reliability (internal consistency Cronbach´s \(\alpha\)) of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)

PP_5.5

PP_5.5$SEd_pre = sqrt(2 * (PP_5.5$ind.pretestSD * sqrt(1 - PP_5.5_Alpha)) ^ 2)
PP_5.5$RCI_ind_preSD = (PP_5.5$POST_Mean - PP_5.5$PRE_Mean) / PP_5.5$SEd_pre
PP_5.5$RCI_ind_preSD_Cutoff =  1.96 * PP_5.5$SEd_pre

# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>% 
#  within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(PP_5.5$PRE_Mean, PP_5.5$RCI_ind_preSD, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_5.5 = 2.248.
Korrelation RCI(ind) nur mit Pre-SD (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.432.

PP_30.30

PP_30.30$SEd_pre = sqrt(2 * (PP_30.30$ind.pretestSD * sqrt(1 - PP_5.5_Alpha)) ^ 2)
PP_30.30$RCI_ind_preSD = (PP_30.30$POST_Mean - PP_30.30$PRE_Mean) / PP_30.30$SEd_pre
PP_30.30$RCI_ind_preSD_Cutoff =  1.96 * PP_30.30$SEd_pre

# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>% 
#  within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(PP_30.30$PRE_Mean, PP_30.30$RCI_ind_preSD, xlab = "PP_30.30$PRE_Mean", ylab = "PP_30.30$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_30.30 = 2.045.
Korrelation RCI(ind) nur mit Pre-SD (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.432.

---

1.8.2 RCI(ind) mit pooled SDs aus beiden individuellen Intervallen

\[ RCI_{ind} = \frac{\overline{x_{2}} - \overline{x_{1}}} {SE_{D}} \]

\[ SE_{D} = \sqrt{(s_{x}^2 + s_{y}^2) \cdot (1 - r_{xy})} \]

\[ \text{significance cutoff} = 1.96 \cdot SE_{D} = 1.96 \cdot \sqrt{(s_{x}^2 + s_{y}^2) \cdot (1 - r_{xy})} \]

\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores, \(SE_{D}\) = pooled standard error of difference between the test scores \(s_{x}\) = individual standard deviation of pretest time points, \(s_{y}\) = individual standard deviation of pretest time points, \(r_{xy}\) = reliability (internal consistency Cronbach´s \(\alpha\)) of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)

PP_5.5

PP_5.5$SEd_pooled = sqrt((PP_5.5$ind.pretestSD ^ 2 + PP_5.5$ind.posttestSD ^ 2) * (1 - PP_5.5_Alpha))
PP_5.5$RCI_ind_pooledSD = (PP_5.5$POST_Mean - PP_5.5$PRE_Mean) / PP_5.5$SEd_pooled
PP_5.5$RCI_ind_pooledSD_Cutoff =  1.96 * PP_5.5$SEd_pooled

# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>% 
#  within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(PP_5.5$PRE_Mean, PP_5.5$RCI_ind_pooledSD, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_5.5 = 2.641.
Korrelation RCI(ind) mit pooled SDs (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.418.

PP_30.30

PP_30.30$SEd_pooled = sqrt((PP_30.30$ind.pretestSD ^ 2 + PP_30.30$ind.posttestSD ^ 2) * (1 - PP_5.5_Alpha))
PP_30.30$RCI_ind_pooledSD = (PP_30.30$POST_Mean - PP_30.30$PRE_Mean) / PP_30.30$SEd_pooled
PP_30.30$RCI_ind_pooledSD_Cutoff =  1.96 * PP_30.30$SEd_pooled

# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>% 
#  within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(PP_30.30$PRE_Mean, PP_30.30$RCI_ind_pooledSD, xlab = "PP_30.30$PRE_Mean", ylab = "PP_30.30$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_30.30 = 2.403.
Korrelation RCI(ind) mit pooled SDs (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.418.

---

1.9 Vergleich RCI(JT) - RCI(ind)

Vergleich des RCI(JT) in der Stichprobe mit je 1 MZP mit anderen RCIs (ind) in Intervall-Daten (je 5 MZP und je 30 MZP)

x = PP_5.5 %>% 
  within(., {RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
         RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA})

y = PP_30.30 %>% 
  within(., {RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
         RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA})

z = PP_1.1 %>% 
  within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})

scatter.hist(x$RCI_ind_preSD, z$RCI_JT, xlab = "PP_5.5$RCI_ind_preSD", ylab = "PP_1.1$RCI_JT", ellipse =  FALSE, grid = TRUE, col = c("dodgerblue",  "darkorange"))

scatter.hist(y$RCI_ind_preSD, z$RCI_JT, xlab = "PP_30.30$RCI_ind_preSD", ylab = "PP_1.1$RCI_JT", ellipse =  FALSE, grid = TRUE, col = c("dodgerblue",  "darkorange"))

scatter.hist(x$RCI_ind_pooledSD, z$RCI_JT, xlab = "PP_5.5$RCI_ind_pooledSD", ylab = "PP_1.1$RCI_JT",  ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

scatter.hist(y$RCI_ind_pooledSD, z$RCI_JT, xlab = "PP_30.30$RCI_ind_pooledSD", ylab = "PP_1.1$RCI_JT",  ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

---

1.10 RCI-Klassifikationen

RCI_Int = tibble(RCI = c("RCI < -1,96","-1,96 <= RCI <= 1,96","RCI > 1,96"),
                Klassifikation = c(-1,0,1),
                Interpretation = c("reliable Verbesserung","keine reliable Veränderung","reliable Verschlechterung"))

PP_5.5: RCI(ind) nur mit Pre-SDs

PP_5.5 = PP_5.5 %>% 
  mutate(RCI_ind_preSD_klass = case_when(
    RCI_ind_preSD < -1.96 ~ -1,
    RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
    RCI_ind_preSD > 1.96 ~ 1,
    TRUE ~ RCI_ind_preSD
  )
)

temp = PP_5.5 %>% 
  dplyr::count(RCI_ind_preSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

RCI	RCI_ind_preSD_klass	Interpretation	n	Percentage
RCI < -1,96	-1	reliable Verbesserung	4987	60.62
-1,96 <= RCI <= 1,96	0	keine reliable Veränderung	2617	31.81
RCI > 1,96	1	reliable Verschlechterung	622	7.56

PP_5.5: RCI(ind) mit pooled SDs

PP_5.5 = PP_5.5 %>% 
  mutate(RCI_ind_pooledSD_klass = case_when(
    RCI_ind_pooledSD < -1.96 ~ -1,
    RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
    RCI_ind_pooledSD > 1.96 ~ 1,
    TRUE ~ RCI_ind_pooledSD
  )
)

temp = PP_5.5 %>% 
  dplyr::count(RCI_ind_pooledSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

RCI	RCI_ind_pooledSD_klass	Interpretation	n	Percentage
RCI < -1,96	-1	reliable Verbesserung	4633	56.32
-1,96 <= RCI <= 1,96	0	keine reliable Veränderung	3192	38.80
RCI > 1,96	1	reliable Verschlechterung	401	4.87

PP_30.30: RCI(ind) nur mit Pre-SDs

PP_30.30 = PP_30.30 %>% 
  mutate(RCI_ind_preSD_klass = case_when(
    RCI_ind_preSD < -1.96 ~ -1,
    RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
    RCI_ind_preSD > 1.96 ~ 1,
    TRUE ~ RCI_ind_preSD
  )
)

temp = PP_30.30 %>% 
  dplyr::count(RCI_ind_preSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

RCI	RCI_ind_preSD_klass	Interpretation	n	Percentage
RCI < -1,96	-1	reliable Verbesserung	5160	62.73
-1,96 <= RCI <= 1,96	0	keine reliable Veränderung	2385	28.99
RCI > 1,96	1	reliable Verschlechterung	681	8.28

PP_30.30: RCI(ind) mit pooled SDs

PP_30.30 = PP_30.30 %>% 
  mutate(RCI_ind_pooledSD_klass = case_when(
    RCI_ind_pooledSD < -1.96 ~ -1,
    RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
    RCI_ind_pooledSD > 1.96 ~ 1,
    TRUE ~ RCI_ind_pooledSD
  )
)

temp = PP_30.30 %>% 
  dplyr::count(RCI_ind_pooledSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

RCI	RCI_ind_pooledSD_klass	Interpretation	n	Percentage
RCI < -1,96	-1	reliable Verbesserung	4808	58.45
-1,96 <= RCI <= 1,96	0	keine reliable Veränderung	2959	35.97
RCI > 1,96	1	reliable Verschlechterung	459	5.58

PP_5.5: RCI(JT)-Zwischenstufe mit Pre-Mean - Post-Mean im Zähler.

PP_5.5 = PP_5.5 %>% 
  mutate(RCI_JT_ZwStufe_klass = case_when(
    RCI_JT_ZwStufe < -1.96 ~ -1,
    RCI_JT_ZwStufe >= -1.96 & RCI_JT_ZwStufe < 1.96 ~ 0,
    RCI_JT_ZwStufe > 1.96 ~ 1,
    TRUE ~ RCI_JT_ZwStufe
  )
)

temp = PP_5.5 %>% 
  dplyr::count(RCI_JT_ZwStufe_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_JT_ZwStufe_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

RCI	RCI_JT_ZwStufe_klass	Interpretation	n	Percentage
RCI < -1,96	-1	reliable Verbesserung	3951	48.03
-1,96 <= RCI <= 1,96	0	keine reliable Veränderung	4007	48.71
RCI > 1,96	1	reliable Verschlechterung	268	3.26

PP_1.1: RCI(JT)

PP_1.1 = PP_1.1 %>% 
  mutate(RCI_JT_klass = case_when(
    RCI_JT < -1.96 ~ -1,
    RCI_JT >= -1.96 & RCI_JT < 1.96 ~ 0,
    RCI_JT > 1.96 ~ 1,
    TRUE ~ RCI_JT
  )
)

temp = PP_1.1 %>% 
  dplyr::count(RCI_JT_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_JT_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

RCI	RCI_JT_klass	Interpretation	n	Percentage
RCI < -1,96	-1	reliable Verbesserung	3776	45.90
-1,96 <= RCI <= 1,96	0	keine reliable Veränderung	4144	50.38
RCI > 1,96	1	reliable Verschlechterung	306	3.72

---

1.11 Edwards-Nunnally-Methode (EN) nach Speer (1992)

\[ \bigl[ r_{xx} (X_{pre} - M_{pre}) + M_{pre} \bigr] \pm 2 \cdot S_{pre} \cdot \sqrt{1 - r_{xx}} \]

\(r_{xx}\) = reliability of the measure, \(X_{pre}\) = individual´s raw score at pre-treatment, \(M_{pre}\) = mean of the sample at pre-treatment, \(S_{pre}\) = standard deviation of the sample at pre-treatment

Interpretation der Post-Ausprägung nach EN-Intervall-Methode

EN_Int = tibble(EN = c("PHQ POST < [EN-Intervall]","PHQ POST im [EN-Intervall]","PHQ POST > [EN-Intervall]"),
                Klassifikation = c(-1,0,1), Interpretation = c("signifikante Verbesserung",
                        "keine signifikante Veränderung","signifikante Verschlechterung"))

EN-Intervalle in PP_5.5

PP_5.5$EN_min = (PP_5.5_Alpha * (PP_5.5$PRE_Mean - mean(PP_5.5$PRE_Mean)) + mean(PP_5.5$PRE_Mean)) - 2 *
  mean(PP_5.5$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)

PP_5.5$EN_max = (PP_5.5_Alpha * (PP_5.5$PRE_Mean - mean(PP_5.5$PRE_Mean)) + mean(PP_5.5$PRE_Mean)) + 2 *
  mean(PP_5.5$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)

PP_5.5 = PP_5.5 %>% 
  mutate(EN_klass = case_when(
    POST_Mean > EN_max ~ 1,
    POST_Mean < EN_max & POST_Mean > EN_min ~ 0,
    POST_Mean < EN_min ~ -1,
    TRUE ~ POST_Mean
  )
)

temp = PP_5.5 %>% 
  dplyr::count(EN_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

EN_Int %>%
  dplyr::rename(EN_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

EN	EN_klass	Interpretation	n	Percentage
PHQ POST < [EN-Intervall]	-1	signifikante Verbesserung	5554	67.52
PHQ POST im [EN-Intervall]	0	keine signifikante Veränderung	1953	23.74
PHQ POST > [EN-Intervall]	1	signifikante Verschlechterung	719	8.74

EN-Intervalle in PP_30.30

PP_30.30$EN_min = (PP_5.5_Alpha * (PP_30.30$PRE_Mean - mean(PP_30.30$PRE_Mean)) + mean(PP_30.30$PRE_Mean)) - 2 * mean(PP_30.30$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)

PP_30.30$EN_max = (PP_5.5_Alpha * (PP_30.30$PRE_Mean - mean(PP_30.30$PRE_Mean)) + mean(PP_30.30$PRE_Mean)) + 2 * mean(PP_30.30$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)

PP_30.30 = PP_30.30 %>% 
  mutate(EN_klass = case_when(
    POST_Mean > EN_max ~ 1,
    POST_Mean < EN_max & POST_Mean > EN_min ~ 0,
    POST_Mean < EN_min ~ -1,
    TRUE ~ POST_Mean
  )
)

temp = PP_30.30 %>% 
  dplyr::count(EN_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

EN_Int %>%
  dplyr::rename(EN_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

EN	EN_klass	Interpretation	n	Percentage
PHQ POST < [EN-Intervall]	-1	signifikante Verbesserung	5665	68.87
PHQ POST im [EN-Intervall]	0	keine signifikante Veränderung	1776	21.59
PHQ POST > [EN-Intervall]	1	signifikante Verschlechterung	785	9.54

EN-Intervalle in PP_1.1

PP_1.1$EN_min = (PP_5.5_Alpha * (PP_1.1$PRE - mean(PP_1.1$PRE)) + mean(PP_1.1$PRE)) - 2 * sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)

PP_1.1$EN_max = (PP_5.5_Alpha * (PP_1.1$PRE - mean(PP_1.1$PRE)) + mean(PP_1.1$PRE)) + 2 * sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)

PP_1.1 = PP_1.1 %>% 
  mutate(EN_klass = case_when(
    POST > EN_max ~ 1,
    POST < EN_max & POST > EN_min ~ 0,
    POST < EN_min ~ -1,
    TRUE ~ as.numeric(POST)
  )
)

temp = PP_1.1 %>% 
  dplyr::count(EN_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

EN_Int %>%
  dplyr::rename(EN_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

EN	EN_klass	Interpretation	n	Percentage
PHQ POST < [EN-Intervall]	-1	signifikante Verbesserung	4568	55.53
PHQ POST im [EN-Intervall]	0	keine signifikante Veränderung	3090	37.56
PHQ POST > [EN-Intervall]	1	signifikante Verschlechterung	568	6.90

---

1.12 Clinically Significant Improvement (CSI)

Clinically Significant Improvement (CSI) vom Pre- zum Post-Intervall

“The original validation study of the PHQ-9 defined clinically significant improvement as [a pre-treatment score >= 10 and] a post-treatment score of <= 9 combined with improvement of 50%.” (McMillan, Gilbody, & Richards, 2010)

CSI_Int = tibble(CSI = c("Pre-Score >= 10 & Post-Score <= 9 & PC >= 50", "every other combination", 
                         "Pre-Score <= 9 & Post-Score >= 10 & PC <= -50"),
                Klassifikation = c(-1,0,1),
                Interpretation = c("klinisch signifikante Verbesserung", "keine klinisch signifikante Veränderung", 
                                   "klinisch signifikante Verschlechterung"))

1.12.1 CSI in PP_5.5

PP_5.5 = PP_5.5 %>% 
   mutate(CSI_klass = case_when(
     PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
     PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
     TRUE ~ 0
   )
)

temp = PP_5.5 %>% 
  dplyr::count(CSI_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

CSI_Int %>%
  dplyr::rename(CSI_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

CSI	CSI_klass	Interpretation	n	Percentage
Pre-Score >= 10 & Post-Score <= 9 & PC >= 50	-1	klinisch signifikante Verbesserung	1738	21.13
every other combination	0	keine klinisch signifikante Veränderung	6306	76.66
Pre-Score <= 9 & Post-Score >= 10 & PC <= -50	1	klinisch signifikante Verschlechterung	182	2.21

---

1.12.2 CSI in PP_30.30

PP_30.30 = PP_30.30 %>% 
   mutate(CSI_klass = case_when(
     PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
     PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
     TRUE ~ 0
   )
)

temp = PP_30.30 %>% 
  dplyr::count(CSI_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

CSI_Int %>%
  dplyr::rename(CSI_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

CSI	CSI_klass	Interpretation	n	Percentage
Pre-Score >= 10 & Post-Score <= 9 & PC >= 50	-1	klinisch signifikante Verbesserung	1738	21.13
every other combination	0	keine klinisch signifikante Veränderung	6306	76.66
Pre-Score <= 9 & Post-Score >= 10 & PC <= -50	1	klinisch signifikante Verschlechterung	182	2.21

---

1.12.3 CSI in PP_1.1

PP_1.1 = PP_1.1 %>% 
   mutate(CSI_klass = case_when(
     PRE >= 10 & POST <= 9 & PC >= 50 ~ -1,
     PRE <= 9 & POST >= 10 & PC <= -50 ~ 1,
     TRUE ~ 0
   )
)

temp = PP_1.1 %>% 
  dplyr::count(CSI_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

CSI_Int %>%
  dplyr::rename(CSI_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

CSI	CSI_klass	Interpretation	n	Percentage
Pre-Score >= 10 & Post-Score <= 9 & PC >= 50	-1	klinisch signifikante Verbesserung	1989	24.18
every other combination	0	keine klinisch signifikante Veränderung	6179	75.12
Pre-Score <= 9 & Post-Score >= 10 & PC <= -50	1	klinisch signifikante Verschlechterung	58	0.71

---

1.13 Individuelle Übereinstimmung der Klassifikationen

Übereinstimmung der Klassifikationen auf individueller Ebene zwischen PP_5.5, PP_30.30 und PP_1.1:

Interpretation von Cohen´s Kappa:

tibble(Cohen_Kappa = c("k < .20",".21 <= k < .40",".41 <= k < .60",".61 <= k < .80","k > .80"),
       Interpretation = c("poor","fair","moderate","good","very good")) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

Cohen_Kappa	Interpretation
k < .20	poor
.21 <= k < .40	fair
.41 <= k < .60	moderate
.61 <= k < .80	good
k > .80	very good

1.13.1 Klinische PHQ-9-Interpretation

Übereinstimmung zwischen den klinischen Interpretationen der PHQ-9-Werte für Pre- und Post-Intervalle (je 5 MZP und je 30 MZP) und für einzelne Pre- und Post-Messzeitpunkte (je 1 MZP):

# PRE
x = PP_5.5 %>% 
  select(ID, PRE_Mean_klass) %>% 
  dplyr::rename(PRE_klass.5 = PRE_Mean_klass)

y = PP_30.30 %>% 
  select(ID, PRE_Mean_klass) %>% 
  dplyr::rename(PRE_klass.30 = PRE_Mean_klass)

z = PP_1.1 %>% 
  select(ID, PRE_klass) %>% 
  dplyr::rename(PRE_klass.1 = PRE_klass)

temp = full_join(x, y, by = "ID") %>% 
  full_join(., z, by = "ID") %>% 
  select(-ID) %>% 
  mutate(across(.cols = everything(), as.factor))

### Cohen´s Kappa
rnames = c("PRE_klass_5.5", "PRE_klass_30.30", "PRE_klass_1.1")

Agreement = matrix(ncol = 3, nrow = 3, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("temp$", names(temp[,i]))))
    y = eval(parse(text = paste0("temp$", names(temp[,j]))))
    
    Agreement[i,j] = CohenKappa(x = x, y = y)
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.7, cex = 0.8, las = 2, 
     key = list(cex.axis=0.7), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa) der PHQ-PRE-Klassifikationen")

# POST
x = PP_5.5 %>% 
  select(ID, POST_Mean_klass) %>% 
  dplyr::rename(POST_klass.5 = POST_Mean_klass)

y = PP_30.30 %>% 
  select(ID, POST_Mean_klass) %>% 
  dplyr::rename(POST_klass.30 = POST_Mean_klass)

z = PP_1.1 %>% 
  select(ID, POST_klass) %>% 
  dplyr::rename(POST_klass.1 = POST_klass)

temp = full_join(x, y, by = "ID") %>% 
  full_join(., z, by = "ID") %>% 
  select(-ID) %>% 
  mutate(across(.cols = everything(), as.factor))

### Cohen´s Kappa
rnames = c("POST_klass_5.5", "POST_klass_30.30", "POST_klass_1.1")

Agreement = matrix(ncol = 3, nrow = 3, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("temp$", names(temp[,i]))))
    y = eval(parse(text = paste0("temp$", names(temp[,j]))))
    
    Agreement[i,j] = CohenKappa(x = x, y = y)
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.7, cex = 0.8, las = 2, 
     key = list(cex.axis=0.7), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa) der PHQ-POST-Klassifikationen")

---

1.13.2 Zusammenfassung der Klassifikations-Häufigkeiten

# einheitliche Kodierung von Verbesserung (-1), keiner Veränderung (0) und Verschlechterung (1):

x = PP_5.5 %>% 
  select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, RCI_JT_ZwStufe_klass, EN_klass, CSI_klass) %>% 
  dplyr::rename(Mean_PC_5.5 = Mean_PC_klass, RCI_ind_preSD_5.5 = RCI_ind_preSD_klass, RCI_ind_pooledSD_5.5 = RCI_ind_pooledSD_klass,
         RCI_JT_ZwStufe_5.5 = RCI_JT_ZwStufe_klass, EN_5.5 = EN_klass, CSI_5.5 = CSI_klass) %>% 
  mutate(Mean_PC_5.5 = recode(Mean_PC_5.5, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))

y = PP_30.30 %>% 
  select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, EN_klass, CSI_klass) %>% 
  dplyr::rename(Mean_PC_30.30 = Mean_PC_klass, RCI_ind_preSD_30.30 = RCI_ind_preSD_klass, 
         RCI_ind_pooledSD_30.30 = RCI_ind_pooledSD_klass, EN_30.30 = EN_klass, CSI_30.30 = CSI_klass) %>% 
  mutate(Mean_PC_30.30 = recode(Mean_PC_30.30, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))

z = PP_1.1 %>% 
  select(ID, PC_klass, RCI_JT_klass, EN_klass, CSI_klass) %>% 
  dplyr::rename(PC_1.1 = PC_klass, RCI_JT_1.1 = RCI_JT_klass, 
         EN_1.1 = EN_klass, CSI_1.1 = CSI_klass) %>% 
  mutate(PC_1.1 = recode(PC_1.1, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))

PP_Class = full_join(x, y, by = "ID") %>% 
  full_join(., z, "ID") %>% 
  select(-ID) %>% 
  dplyr::mutate(across(.cols = everything(), as.factor))
#save(PP_Class, file = "cor_07_k20/PP_Class.RData")

rnames = names(PP_Class)

#view(dfSummary(PP_Class))
#dfSummary(PP_Class, plain.ascii = FALSE, style = 'grid', graph.magnif = 0.75, valid.col = FALSE, tmp.img.dir = "/tmp")
#dfSummary(PP_Class)
print(dfSummary(PP_Class, varnumbers = FALSE, plain.ascii = FALSE, style = 'grid', graph.magnif = 0.75, valid.col = FALSE, na.col = FALSE, display.labels = FALSE, silent = FALSE, headers = FALSE, footnote = NA, tmp.img.dir = "/tmp"), method = 'render')

Data Frame Summary

PP_Class

Dimensions: 8226 x 15
Duplicates: 7890

Variable	Stats / Values	Freqs (% of Valid)	Graph
Mean_PC_5.5 [factor]	1. -1 2. 0 3. 1	2560 ( 31.1% ) 5441 ( 66.1% ) 225 ( 2.7% )
RCI_ind_preSD_5.5 [factor]	1. -1 2. 0 3. 1	4987 ( 60.6% ) 2617 ( 31.8% ) 622 ( 7.6% )
RCI_ind_pooledSD_5.5 [factor]	1. -1 2. 0 3. 1	4633 ( 56.3% ) 3192 ( 38.8% ) 401 ( 4.9% )
RCI_JT_ZwStufe_5.5 [factor]	1. -1 2. 0 3. 1	3951 ( 48.0% ) 4007 ( 48.7% ) 268 ( 3.3% )
EN_5.5 [factor]	1. -1 2. 0 3. 1	5554 ( 67.5% ) 1953 ( 23.7% ) 719 ( 8.7% )
CSI_5.5 [factor]	1. -1 2. 0 3. 1	1738 ( 21.1% ) 6306 ( 76.7% ) 182 ( 2.2% )
Mean_PC_30.30 [factor]	1. -1 2. 0 3. 1	2560 ( 31.1% ) 5441 ( 66.1% ) 225 ( 2.7% )
RCI_ind_preSD_30.30 [factor]	1. -1 2. 0 3. 1	5160 ( 62.7% ) 2385 ( 29.0% ) 681 ( 8.3% )
RCI_ind_pooledSD_30.30 [factor]	1. -1 2. 0 3. 1	4808 ( 58.5% ) 2959 ( 36.0% ) 459 ( 5.6% )
EN_30.30 [factor]	1. -1 2. 0 3. 1	5665 ( 68.9% ) 1776 ( 21.6% ) 785 ( 9.5% )
CSI_30.30 [factor]	1. -1 2. 0 3. 1	1738 ( 21.1% ) 6306 ( 76.7% ) 182 ( 2.2% )
PC_1.1 [factor]	1. -1 2. 0 3. 1	2933 ( 35.7% ) 5118 ( 62.2% ) 175 ( 2.1% )
RCI_JT_1.1 [factor]	1. -1 2. 0 3. 1	3776 ( 45.9% ) 4144 ( 50.4% ) 306 ( 3.7% )
EN_1.1 [factor]	1. -1 2. 0 3. 1	4568 ( 55.5% ) 3090 ( 37.6% ) 568 ( 6.9% )
CSI_1.1 [factor]	1. -1 2. 0 3. 1	1989 ( 24.2% ) 6179 ( 75.1% ) 58 ( 0.7% )

Generated by summarytools 0.9.6 (R version 4.0.2)
2020-12-13

---

1.13.3 Übereinstimmung der Klassifikations-Häufigkeiten

Gesamt-Übereinstimmung

### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
    
    Agreement[i,j] = CohenKappa(x = x, y = y)
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa) der Klassifikationen")

### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Percentage_Agreement)) {
  for (j in 1:ncol(Percentage_Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
    
    Percentage_Agreement[i,j] = Agree(cbind(x, y))[1]
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
  title(main = "Prozentuale Übereinstimmung der Klassifikationen")

Übereinstimmung nur für Verbesserung (-1)

### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i])))) %>% 
      dplyr::recode_factor(., '-1' = -1L)
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j])))) %>% 
      dplyr::recode_factor(., '-1' = -1L)
    
    Agreement[i,j] = CohenKappa(x = x, y = y, useNA = "ifany")
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa): Verbesserung (-1)")

### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Percentage_Agreement)) {
  for (j in 1:ncol(Percentage_Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
    
    Percentage_Agreement[i,j] = length(which(x == -1L & y == -1L)) / 
      length(which(x == -1L | y == -1L))
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
  title(main = "Prozentuale Übereinstimmung: Verbesserung (-1)")

Übereinstimmung nur für Verschlechterung (1)

### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i])))) %>% 
      recode_factor(., '1' = 1L)
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j])))) %>% 
      recode_factor(., '1' = 1L)
    
    Agreement[i,j] = CohenKappa(x = x, y = y, useNA = "ifany")
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa): Verschlechterung (1)")

### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Percentage_Agreement)) {
  for (j in 1:ncol(Percentage_Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
    
    Percentage_Agreement[i,j] = length(which(x == 1L & y == 1L)) / 
      length(which(x == 1L | y == 1L))
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
  title(main = "Prozentuale Übereinstimmung: Verschlechterung (1)")

---

1.14 Sensitivität und Spezifität der Klassifikationsmethoden

Diagnostische Sensitivität und Spezifität einer “neuen” Testmethode im Vergleich zu einer “Goldstandard”-Testmethode:
Sensitivität = Wahrscheinlichkeit für ein richtig-positives Testergebnis
Spezifität = Wahrscheinlichkeit für ein richtig-negatives Testergebnis

\[ Sensitivity = Recall = TPR = \frac{\sum{\text{True Positives}}} {\sum{\text{True Positives}} + \sum{\text{False Negatives}}} = \frac{tp}{tp + fn} \]

\[ Specificity = Selectivity = TNR = \frac{\sum{\text{True Negatives}}} {\sum{\text{True Negatives}} + \sum{\text{False Positives}}} = \frac{tn}{tn + fp} \]

\[ \textit{Geometric Mean of Sensitivity and Specificity} = \sqrt{Sensitivity \cdot Specificity} \]

\[ Sensitivity_{\textit{class-weighted average}} = Recall_{wgt} = \rho_{wgt} = \sum_{k=1}^{c} \frac{n_k}{n} \rho_k = \frac{1}{n} \sum_{k=1}^{c} tp^{(k)} = \frac{tp^{(deteriorated)}} {tp^{(deteriorated)} + fn^{(deteriorated)}} + \frac{tp^{(\textit{not changed})}} {tp^{(\textit{not changed})} + fn^{(\textit{not changed})}} + \frac{tp^{(improved)}} {tp^{(improved)} + fn^{(improved)}} \]

\(c\) = number of classes (i.e. 3: deteriorated; not changed; improved); \(n_k\) = number of cases belonging to class \(k\), with \(k=1,...,c\); \(n\) = total number of cases, with \(n = \sum_{k=1}^{c} n_k\)

Sensitivität & Spezifität gegenüber Veränderung:
Evaluation der Veränderungs-Klassifikationen der Klassifikationsmethoden im Vergleich zur klinischen Signifikanz CSI (je 30 MZP) als “Goldstandard”:

ClassEval = list()
for (i in 1:ncol(PP_Class)) {
  x = eval(parse(text = paste0("PP_Class$", colnames(PP_Class[,i]))))
  cm = confusionMatrix(x, reference = PP_Class$CSI_30.30, 
                       dnn = c(paste0("PP_Class$", names(PP_Class[,i])), "CSI 30.30"), mode = "everything")
  cm$agreement = cm$overall[c("Accuracy","Kappa")]
  cm$senspez = cm$byClass %>% 
    as_tibble() %>% 
    select(Sensitivity, Specificity)
  
  cm$senspez_cwa = cm$senspez %>% 
    summarise(across(.cols = everything(), .fns = geometric.mean, .names = "{.col}_cwa")) %>% 
    mutate(GMean_SenSpez = geometric.mean(c(Sensitivity_cwa, Specificity_cwa)))
  
  ClassEval[[paste0(names(PP_Class[,i]))]] = cm[c("table","agreement","senspez","senspez_cwa")]
}

#save(ClassEval, file = "cor_07_k20/PP_ClassEval.RData")
#load("cor_07_k20/PP_Class.RData")

SenSpezSumm = tibble(Frequency = as.factor(c(rep("5.5", 6), rep("30.30", 5), rep("1.1", 4))),
                 Method = colnames(PP_Class),
                 Sens_imp = as.numeric(NA),
                 Sens_not = as.numeric(NA),
                 Sens_det = as.numeric(NA),
                 Spec_imp = as.numeric(NA),
                 Spec_not = as.numeric(NA),
                 Spec_det = as.numeric(NA),
                 Sensitivity_cwa = as.numeric(NA),
                 Specificity_cwa = as.numeric(NA),
                 SenSpec_mean = as.numeric(NA),
                 Accuracy_PercAgree = as.numeric(NA),
                 Kappa = as.numeric(NA))

for (i in 1:nrow(SenSpezSumm)) {
  SenSpezSumm[i,"Sens_imp"] = ClassEval[[i]][["senspez"]]$Sensitivity[1]
  SenSpezSumm[i,"Sens_not"] = ClassEval[[i]][["senspez"]]$Sensitivity[2]
  SenSpezSumm[i,"Sens_det"] = ClassEval[[i]][["senspez"]]$Sensitivity[3]
  
  SenSpezSumm[i,"Spec_imp"] = ClassEval[[i]][["senspez"]]$Specificity[1]
  SenSpezSumm[i,"Spec_not"] = ClassEval[[i]][["senspez"]]$Specificity[2]
  SenSpezSumm[i,"Spec_det"] = ClassEval[[i]][["senspez"]]$Specificity[3]
  
  SenSpezSumm[i,"Sensitivity_cwa"] = ClassEval[[i]][["senspez_cwa"]]$Sensitivity_cwa
  SenSpezSumm[i,"Specificity_cwa"] = ClassEval[[i]][["senspez_cwa"]]$Specificity_cwa
  SenSpezSumm[i,"SenSpec_mean"] = ClassEval[[i]][["senspez_cwa"]]$GMean_SenSpez
  
  SenSpezSumm[i,"Accuracy_PercAgree"] = ClassEval[[i]][["agreement"]][[1]]
  SenSpezSumm[i,"Kappa"] = ClassEval[[i]][["agreement"]][[2]]
}

#save(SenSpezSumm, file = "cor_07_k20/PP_SenSpezSumm.RData")
#load("cor_07_k20/PP_SenSpezSumm.RData")

SenSpezSumm %>% 
  mutate(across(.cols = where(is.numeric), .fns = round, digits = 2)) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

Frequency	Method	Sens_imp	Sens_not	Sens_det	Spec_imp	Spec_not	Spec_det	Sensitivity_cwa	Specificity_cwa	SenSpec_mean	Accuracy_PercAgree	Kappa
5.5	Mean_PC_5.5	1.00	0.86	1.00	0.87	1.00	0.99	0.95	0.95	0.95	0.89	0.75
5.5	RCI_ind_preSD_5.5	1.00	0.41	0.98	0.50	1.00	0.94	0.74	0.78	0.76	0.55	0.28
5.5	RCI_ind_pooledSD_5.5	1.00	0.50	0.93	0.55	0.99	0.97	0.78	0.81	0.79	0.62	0.35
5.5	RCI_JT_ZwStufe_5.5	1.00	0.63	0.97	0.66	1.00	0.99	0.85	0.87	0.86	0.72	0.46
5.5	EN_5.5	1.00	0.31	1.00	0.41	1.00	0.93	0.68	0.73	0.70	0.47	0.21
5.5	CSI_5.5	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00
30.30	Mean_PC_30.30	1.00	0.86	1.00	0.87	1.00	0.99	0.95	0.95	0.95	0.89	0.75
30.30	RCI_ind_preSD_30.30	1.00	0.38	0.99	0.47	1.00	0.94	0.72	0.76	0.74	0.52	0.26
30.30	RCI_ind_pooledSD_30.30	1.00	0.47	0.97	0.53	1.00	0.96	0.77	0.80	0.78	0.59	0.32
30.30	EN_30.30	1.00	0.28	1.00	0.39	1.00	0.93	0.66	0.71	0.68	0.45	0.20
30.30	CSI_30.30	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00	1.00
1.1	PC_1.1	0.71	0.71	0.09	0.74	0.66	0.98	0.35	0.78	0.53	0.69	0.32
1.1	RCI_JT_1.1	0.85	0.59	0.13	0.65	0.79	0.96	0.40	0.79	0.56	0.64	0.30
1.1	EN_1.1	0.90	0.44	0.20	0.54	0.84	0.93	0.43	0.75	0.57	0.54	0.22
1.1	CSI_1.1	0.61	0.85	0.05	0.86	0.56	0.99	0.31	0.78	0.49	0.78	0.41

graphics::barplot(SenSpezSumm$Sensitivity_cwa ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7, 
                  horiz = TRUE, main = "Sensitivity to Change (Reference = CSI_30.30)")
graphics::barplot(SenSpezSumm$Specificity_cwa ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7,
                  horiz = TRUE, main = "Specificity to Change (Reference = CSI_30.30)")

graphics::barplot(SenSpezSumm$SenSpec_mean ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7, 
                  horiz = TRUE, main = "Mean of Sensitivity and Specificity (Reference = CSI_30.30)")
graphics::barplot(SenSpezSumm$Accuracy_PercAgree ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7, 
                  horiz = TRUE, main = "Accuracy = Percentage Agreement (Reference = CSI_30.30)")
graphics::barplot(SenSpezSumm$Kappa ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7, 
                  horiz = TRUE, main = "Agreement: Cohen´s Kappa (Reference = CSI_30.30)")

1.15 Jackknife-Methode zum Resampling von Messzeitpunkten

Statt wenige zufällige MZP-Kombinationen zu ziehen und diese dann mit den “wahren” Schätzwerten und Klassifikationen (= berechnet anhand der gesamten Intervalle mit je 30 MZP) zu vergleichen, sollen die empirische Verteilung der Parameter und somit der Schätzfehler über Resampling-Methoden wie Jackknife-Verfahren und Bootstrapping berechnet werden.

Percentage Change (PC)

###### PP_5.5
n = 5

Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}

for (i in 1:nrow(PP_5.5)) {
  df = data.frame(PRE = as.numeric(PP_5.5[i,pre_5mzp]), POST = as.numeric(PP_5.5[i,post_5mzp]))
  
  PP_5.5[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
  PP_5.5[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
  message(i)
}

PP_5.5_Mean_PC_JK = PP_5.5 %>% 
  select(ID, Mean_PC_jse, Mean_PC_jbias)
save(PP_5.5_Mean_PC_JK, file = "Jackknife/PP_5.5_Mean_PC_JK_k20.RData")

###### PP_30.30
n = 30

Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}

for (i in 1:nrow(PP_30.30)) {
  df = data.frame(PRE = as.numeric(PP_30.30[i,pre_30mzp]), POST = as.numeric(PP_30.30[i,post_30mzp]))
  
  PP_30.30[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
  PP_30.30[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
  message(i)
}

PP_30.30_Mean_PC_JK = PP_30.30 %>% 
  select(ID, Mean_PC_jse, Mean_PC_jbias)
save(PP_30.30_Mean_PC_JK, file = "Jackknife/PP_30.30_Mean_PC_JK_k20.RData")

load("Jackknife/PP_5.5_Mean_PC_JK_k20.RData")
load("Jackknife/PP_30.30_Mean_PC_JK_k20.RData")

PP_5.5 = full_join(PP_5.5, PP_5.5_Mean_PC_JK, by = "ID")
PP_30.30 = full_join(PP_30.30, PP_30.30_Mean_PC_JK, by = "ID")

temp = tibble(Jackknife_SE = c(PP_5.5$Mean_PC_jse, PP_30.30$Mean_PC_jse),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$Mean_PC_jse)))

temp %>%
  ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife SE of Mean Percentage Change", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_SE)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife SEs") +
#  xlab("Dataset")


temp = tibble(Jackknife_Bias = c(PP_5.5$Mean_PC_jbias, PP_30.30$Mean_PC_jbias),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$Mean_PC_jbias)))

temp %>%
  ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife Bias of Mean Percentage Change", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_Bias)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife Biases") +
#  xlab("Dataset")

RCI(ind) nur mit SD aus dem individuellen Pre-Intervall

###### PP_5.5
n = 5

RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - PP_5.5_Alpha))^2)}

for (i in 1:nrow(PP_5.5)) {
  df = data.frame(PRE = as.numeric(PP_5.5[i,pre_5mzp]), POST = as.numeric(PP_5.5[i,post_5mzp]))
  
  PP_5.5[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
  PP_5.5[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
  message(i)
}

PP_5.5_RCI_ind_preSD_JK = PP_5.5 %>% 
  select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(PP_5.5_RCI_ind_preSD_JK, file = "Jackknife/PP_5.5_RCI_ind_preSD_JK_k20.RData")

###### PP_30.30
n = 30

RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - PP_5.5_Alpha))^2)}

for (i in 1:nrow(PP_30.30)) {
  df = data.frame(PRE = as.numeric(PP_30.30[i,pre_30mzp]), POST = as.numeric(PP_30.30[i,post_30mzp]))
  
  PP_30.30[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
  PP_30.30[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
  message(i)
}

PP_30.30_RCI_ind_preSD_JK = PP_30.30 %>% 
  select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(PP_30.30_RCI_ind_preSD_JK, file = "Jackknife/PP_30.30_RCI_ind_preSD_JK_k20.RData")

load("Jackknife/PP_5.5_RCI_ind_preSD_JK_k20.RData")
load("Jackknife/PP_30.30_RCI_ind_preSD_JK_k20.RData")

PP_5.5 = full_join(PP_5.5, PP_5.5_RCI_ind_preSD_JK, by = "ID")
PP_30.30 = full_join(PP_30.30, PP_30.30_RCI_ind_preSD_JK, by = "ID")

temp = tibble(Jackknife_SE = c(PP_5.5$RCI_ind_preSD_jse, PP_30.30$RCI_ind_preSD_jse),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_preSD_jse)))

temp %>%
  ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife SE of RCI(ind) With Pre-SDs", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_SE)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife SEs") +
#  xlab("Dataset")


temp = tibble(Jackknife_Bias = c(PP_5.5$RCI_ind_preSD_jbias, PP_30.30$RCI_ind_preSD_jbias),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_preSD_jbias)))

temp %>%
  ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife Bias of RCI(ind) With Pre-SDs", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_Bias)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife Biases") +
#  xlab("Dataset")

RCI(ind) mit pooled SDs aus beiden individuellen Intervallen

###### PP_5.5
n = 5

RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - PP_5.5_Alpha))}

for (i in 1:nrow(PP_5.5)) {
  df = data.frame(PRE = as.numeric(PP_5.5[i,pre_5mzp]), POST = as.numeric(PP_5.5[i,post_5mzp]))
  
  PP_5.5[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
  PP_5.5[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
  message(i)
}

PP_5.5_RCI_ind_pooledSD_JK = PP_5.5 %>% 
  select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(PP_5.5_RCI_ind_pooledSD_JK, file = "Jackknife/PP_5.5_RCI_ind_pooledSD_JK_k20.RData")

###### PP_30.30
n = 30

RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - PP_5.5_Alpha))}

for (i in 1:nrow(PP_30.30)) {
  df = data.frame(PRE = as.numeric(PP_30.30[i,pre_30mzp]), POST = as.numeric(PP_30.30[i,post_30mzp]))
  
  PP_30.30[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
  PP_30.30[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
  message(i)
}

PP_30.30_RCI_ind_pooledSD_JK = PP_30.30 %>% 
  select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(PP_30.30_RCI_ind_pooledSD_JK, file = "Jackknife/PP_30.30_RCI_ind_pooledSD_JK_k20.RData")

load("Jackknife/PP_5.5_RCI_ind_pooledSD_JK_k20.RData")
load("Jackknife/PP_30.30_RCI_ind_pooledSD_JK_k20.RData")

PP_5.5 = full_join(PP_5.5, PP_5.5_RCI_ind_pooledSD_JK, by = "ID")
PP_30.30 = full_join(PP_30.30, PP_30.30_RCI_ind_pooledSD_JK, by = "ID")

temp = tibble(Jackknife_SE = c(PP_5.5$RCI_ind_pooledSD_jse, PP_30.30$RCI_ind_pooledSD_jse),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_pooledSD_jse)))

temp %>%
  ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife SE of RCI(ind) With Pooled SDs", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_SE)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife SEs") +
#  xlab("Dataset")


temp = tibble(Jackknife_Bias = c(PP_5.5$RCI_ind_pooledSD_jbias, PP_30.30$RCI_ind_pooledSD_jbias),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_pooledSD_jbias)))

temp %>%
  ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife Bias of RCI(ind) With Pooled SDs", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_Bias)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife Biases") +
#  xlab("Dataset")

---